您的位置:网站首页 > CAD新闻

一次修改多条线条等长的小程序

时间:2009-12-13 11:19:00 来源:

可以一次性修改多条线条并指定等长线条
(defun c:x1 (/ EN0 EN0-DATA EN0-LEN INDEX SS SS-LEN TMP-10 TMP-11 TMP-ANG TMP-DATA TMP-EN TMP-PT)
  (if (setq ss (ssget '((0 . "LINE"))))
    (if    (setq en0 (car (entsel "n选择一条基准直线:")))
      (progn
    (setq en0-data (entget en0))
    (setq en0-len (distance (cdr (assoc 10 en0-data)) (cdr (assoc 11 en0-data))))
    (setq index 0)
    (while (< index (sslength ss))
      (setq tmp-en (ssname ss index))      
      (setq tmp-data (entget tmp-en))
      (setq tmp-10 (cdr (assoc 10 tmp-data)))
      (setq tmp-11 (cdr (assoc 11 tmp-data)))
      (setq tmp-ang (angle tmp-10 tmp-11))
      (setq tmp-pt (polar tmp-10 tmp-ang en0-len))
      (setq tmp-data (subst (cons 11 tmp-pt) (assoc 11 tmp-data)  tmp-data))
      (entmod tmp-data)
      (entupd tmp-en)
      (setq index (1+ index))      
    )
      )
    )
  )
  (princ)未命名.gif
)