走马观花：双向延伸、剪切

尘缘一生 · 发表于 2021-7-15 08:10:37

有个好思路，代码才效率高，怎么写倒不是个事。

;;伸剪-----------------
(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)
)
)
)
)

yoyoho · 发表于 2021-7-16 21:12:37

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

cghdy · 发表于 2021-7-16 09:13:57

缺几个函数，试不出来。能录个gif也好。

尘缘一生 · 发表于 2021-7-17 02:51:41

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

ZMB7211 · 发表于 2021-11-23 11:30:43

这个好这个好

账号		自动登录	找回密码
密码			注册