走马观花：双向延伸、剪切
有个好思路，代码才效率高，怎么写倒不是个事。[*];;伸剪-----------------
[*](defun c:slls (/ ss n fz1 xn en_dat en_type en_qd en_zd fz2 jd oldr newr dis)
[*](princ "选择直线或一段的多线")
[*](while (setq ss (ssget ":S"))
[*] (redraw)
[*] (setq fz1 (getpoint "请选择延伸、剪切定位点"))
[*] (setq dis (* 100 (/ (getvar "viewsize") (cadr (getvar "screensize")))))
[*] (repeat (setq n (sslength ss))
[*] (setq xn (ssname ss (setq n (1- n))))
[*] (setq en_dat (entget xn))
[*] (setq en_type (dxf1 en_dat 0))
[*] (setq en_qd (vlax-curve-getstartpoint xn))
[*] (setq en_zd (vlax-curve-getendpoint xn))
[*] (setq fz2 (polar fz1 (+ (angle en_qd en_zd) pi2) dis))
[*] (setq jd (inters en_qd en_zd fz1 fz2 nil))
[*] (if (= en_type "LINE")
[*] (if (> (distance en_qd jd) (distance en_zd jd))
[*] (entmod (emod en_dat 11 jd))
[*] (entmod (emod en_dat 10 jd))
[*] )
[*] )
[*] (if (= en_type "LWPOLYLINE")
[*] (if (> (distance en_qd jd) (distance en_zd jd))
[*] (progn
[*] (setq oldr (assoc 10 (reverse en_dat)))
[*] (setq newr (cons 10 jd))
[*] (setq en_dat (subst newr oldr en_dat))
[*] (entmod en_dat)
[*] )
[*] (entmod (emod en_dat 10 jd))
[*] )
[*] )
[*] (if (= n 0)
[*] (grdraw fz1 fz2 3 2)
[*] )
[*] )
[*])
[*])
cghdy 发表于 2021-7-16 09:13
缺几个函数，试不出来。能录个gif也好。
(defun dxf1 (lst dxf)
(cdr (assoc dxf lst))
)
(defun emod(dxf i value / a b)
(setq b(cons i value))
(if(setq a(assoc i dxf))(subst(cons i value)a dxf)(append dxf(list(cons i value))))) 缺几个函数，试不出来。能录个gif也好。 cghdy 发表于 2021-7-16 09:13
缺几个函数，试不出来。能录个gif也好。
;;;常量定义
(setq *Acad* (vlax-get-acad-object)
*AcDocument* (vla-get-activedocument *Acad*); 获取当前图档指针
*Model-Space* (vla-get-modelspace *AcDocument*)
*Paper-Space* (vla-get-PaperSpace *AcDocument*)
pi2 (* pi 0.5)
pi4 (* pi 0.25)
3pi4 (* 0.75 pi)
2pi (+ pi pi)
3pi2 (+ 3pi4 3pi4);; (* 1.5 pi)
5pi4 (+ pi pi4);;(* 1.25 pi)
7pi4 (+ 3pi2 pi4) ;;(* 1.75 pi)
) 这个好 这个好
页:
[1]