社区 › AutoLISP/Visual LISP 编程技术 › 哪个有把一小段直线转成构造线的小程式吗

futuremh 发表于 2007-8-31 13:23:00

哪个有把一小段直线转成构造线的小程式吗

哪个有把一小段直线转成构造线的小程式吗

highflybir 发表于 2007-8-31 18:41:00

本帖最后由 作者 于 2007-8-31 18:49:36 编辑


(defun c:test(/ lin lst pt1 pt2 vec mid)
(if (and (setq lin (car (entsel "\n请选择直线段:")))
    (setq lst (entget lin))
    (= (cdr (assoc 0 lst)) "LINE")
      )
    (progn
      (setq pt1 (cdr (assoc 10 lst)))
      (setq pt2 (cdr (assoc 11 lst)))
      (setq vec (mapcar '- pt2 pt1))
      (setq mid (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2)))
      (entmake
      (list
   '(0 . "XLINE")
   '(100 . "AcDbEntity")
   '(100 . "AcDbXline")
   (cons 10 mid)
   (cons 11 vec)
)
      )
    )
)
)
如果要批量转：

(defun c:test(/ i sel ent lst pt1 pt2 vec mid)
(setq i 0)
(prompt "\n请选择直线段:")
(if (setq sel (ssget '((0 . "LINE"))))
    (repeat (sslength sel)
      (setq ent (ssname sel i))
      (setq lst (entget ent))
      (setq pt1 (cdr (assoc 10 lst)))
      (setq pt2 (cdr (assoc 11 lst)))
      (setq vec (mapcar '- pt2 pt1))
      (setq mid (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2)))   
      (setq i (1+ i))
      (entdel ent)
      (entmake
      (list
   '(0 . "XLINE")
   '(100 . "AcDbEntity")
   '(100 . "AcDbXline")
   (cons 10 mid)
   (cons 11 vec)
)
      )
    )
)
(princ)
)

futuremh 发表于 2007-8-31 22:23:00

<p>谢谢楼上兄台谢了.</p>

tangjunasd58 发表于 2013-6-21 15:25:48

能在偏移构造线的时候，同时生成一个矩形。。。。。。。。。。。。。

查看完整版本: 哪个有把一小段直线转成构造线的小程式吗