本帖最后由 gcho 于 2018-11-5 11:34 编辑
测试很强大，可以解决这种问题吗，已知直线AC，B点为直线AC的中点，想把另一条直线BC改为虚线，同时裁剪删除直线AC的BC段吗？
这个功能很实用
攒攒赞:lol
看看狼大师的新作
感谢langjs分享，谢谢
gcho 发表于 2018-11-5 11:09
测试很强大，可以解决这种问题吗，已知直线AC，B点为直线AC的中点，想把另一条直线BC改为虚线，同时裁剪删 ...
这个有啥用呢？有源码了很容易就改出来
(defun c:qq ( / code en ent gr i loop name nearpt p0 p1 p2 pd pdlst pt ss x)
(defun sub (i x ent)
(subst(cons i x)(assoc i ent) ent))
(setvar "cmdecho" 0)
(if (null (tblsearch "ltype" "DASHED")) (command "-linetype" "L" "DASHED" "" ""))
(if (= (tblsearch "layer" "4虚线层") nil)
(command "layer" "new" "4虚线层" "c" 6 "4虚线层" "lt" "DASHED" "4虚线层" ""))
(setq loop t pdlst nil pd nil )
(princ "\n请指定对象,[右键]退出:")
(while loop
(setq gr (grread t 15 2) code (car gr) pt (cadr gr))
(cond
((= code 3)
(if pd(setq pdlst nilpd nil)))
((or (= code 11) (= code 25))
(if pd (progn (princ "\n请指定对象,[右键]退出:") (entdel (car pdlst))
(setq pdlst nilpd nil )) (setq loop nil) ) )
((= code 5)
(if (setq nearpt (osnap pt "_NEA"))
(if (and (not pd) (setq ss (ssget "C" nearpt nearpt '((0 . "LINE"))))
(setq name (ssname ss 0)) (setq ent (entget name))
(not (member name pdlst)) )
(progn
(princ "\n[左键]确认,[右键]删除")
(setq pdlst (cons name pdlst) p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)))
(if (< (distance nearpt p2) (distance nearpt p1))
(setq p0 p2p2 p1p1 p0 ))
(setq p0 (polar p1 (angle p1 p2) (* 0.5 (distance p1 p2)))
ent (sub 10 p0 ent)ent (sub 11 p2 ent))(entmod ent)
(setq en (cdr ent) en (sub 10 p1 en) en (sub 11 p0 en))
(entmake (sub 8 "4虚线层" en))
(setq pd "Y" pdlst (cons (entlast) pdlst))))
(if pd (progn (princ "\n请指定对象,[右键]退出:") (entdel (car pdlst))
(setq ent (entget (last pdlst))ent (sub 10 p1 ent)
ent (sub 11 p2 ent))(entmod ent)
(setq pdlst nilpd nil) ))))))
(princ)
)
虽然少用，支持一下
实用且牛B，牛牛牛
回复向大师学习
这么牛B的操作，确实值得学习！