将直线更改为引线（&P）
此代码可以将线更改为引线，但不支持PLINE，并且无法选择箭头的哪一侧谁能帮我？
谢谢
(defun c:tt ()
(setvar "CMDECHO" 0)
(if (setq ss (ssget '((0 . "LINE")))) (progn
(setq i -1)
(repeat (sslength ss)
(setq ent (entget (ssname ss (setq i (1+ i))))
p1 (cdr(assoc 10 ent))
p2 (cdr(assoc 11 ent)))
(command "_.LEADER" p1 p2 "" "" "N")
)
(command "_.ERASE" ss "")
))
(setvar "CMDECHO" 1)
(princ)
) 选择只有两个坐标的单线或多段线，并告诉我。
(defun c:test (/ s ld sn 1p 2p 3p 4p gr l)
;; Tharwat 12. Mar. 2014 ;;
(princ
"\n Select Single line or Polyline to two coordinates only "
)
(if (setq s (ssget "_+.:S:E:L"
'((-4 . "<OR")
(0 . "LINE")
(-4 . "<AND")
(0 . "LWPOLYLINE")
(90 . 2)
(70 . 0)
(-4 . "AND>")
(-4 . "OR>")
)
)
)
(progn
(defun ld (a b)
(entmakex (list '(0 . "LEADER")
'(100 . "AcDbEntity")
'(100 . "AcDbLeader")
(cons 10 a)
(cons 10 b)
)
)
)
(while (eq (car (setq gr (grread t 13 0))) 5)
(redraw)
(if
(< (distance
(setq
1p (vlax-curve-getstartpoint (setq sn (ssname s 0)))
)
(cadr gr)
)
(distance (setq 2p (vlax-curve-getendpoint sn)) (cadr gr))
)
(progn
(grdraw 1p (cadr gr) 1 1)
(if l
(entdel l)
)
(setq l (ld 1p 2p))
)
(progn
(grdraw 2p (cadr gr) 1 1)
(if l
(entdel l)
)
(setq l (ld 2p 1p))
)
)
)
(if (eq (car gr) 3)
(entdel sn)
)
)
)
(redraw)
(princ)
)
有关更多详细信息
哦很好，代码很好。Tharwat，非常感谢！
太好了，不客气。
页:
[1]