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

futuremh

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

highflybir

3. (defun c:test(/ lin lst pt1 pt2 vec mid)
4.   (if (and (setq lin (car (entsel "\n请选择直线段:")))
5.     (setq lst (entget lin))
6.     (= (cdr (assoc 0 lst)) "LINE")
7.       )  
8.     (progn
9.       (setq pt1 (cdr (assoc 10 lst)))
10.       (setq pt2 (cdr (assoc 11 lst)))
11.       (setq vec (mapcar '- pt2 pt1))
12.       (setq mid (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2)))
13.       (entmake
14.         (list
15.    '(0 . "XLINE")
16.    '(100 . "AcDbEntity")
17.    '(100 . "AcDbXline")
18.    (cons 10 mid)
19.    (cons 11 vec)
20. )
21.       )
22.     )
23.   )
24. )

(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) )       )     )   ) )

如果要批量转：

3. (defun c:test(/ i sel ent lst pt1 pt2 vec mid)
4.   (setq i 0)
5.   (prompt "\n请选择直线段:")
6.   (if (setq sel (ssget '((0 . "LINE"))))
7.     (repeat (sslength sel)
8.       (setq ent (ssname sel i))
9.       (setq lst (entget ent))
10.       (setq pt1 (cdr (assoc 10 lst)))
11.       (setq pt2 (cdr (assoc 11 lst)))
12.       (setq vec (mapcar '- pt2 pt1))
13.       (setq mid (polar pt1 (angle pt1 pt2) (/ (distance pt1 pt2) 2)))   
14.       (setq i (1+ i))
15.       (entdel ent)
16.       (entmake
17.         (list
18.    '(0 . "XLINE")
19.    '(100 . "AcDbEntity")
20.    '(100 . "AcDbXline")
21.    (cons 10 mid)
22.    (cons 11 vec)
23. )
24.       )
25.     )
26.   )
27.   (princ)
28. )

(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

谢谢楼上兄台谢了.

tangjunasd58

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