kzd2004 发表于 2023-6-15 08:08
大佬，提示输入的列表有缺陷，请保存lsp文件发给我，成分感谢！
你直接用TXT保存的？ 那要保存成ANSI编码 最好还是复制到编辑器保存
飞雪神光 发表于 2023-6-15 19:49
你直接用TXT保存的？ 那要保存成ANSI编码 最好还是复制到编辑器保存
谢谢你的回复，感谢感谢!
;;;获取曲线的顶点
(defun get_pline-vertexs (et / i v lst)
(setq en (car (entsel)));;选择曲线并获取名称
(setq et (vlax-ename->vla-object en));;将实体转换为vla对象
(setq i 0);;计数器赋初值
(while (setq v (vlax-curve-getpointatparam et (setq i (1+ i))));;沿曲线返回指定参数值处的点 。
(setq lst (cons v lst))
)
(reverse lst)
)
;;;使用方法：
;;;在命令行输入:(get_pline-vertexs et)
(get_pline-vertexs et)
本帖最后由 kzd2004 于 2023-6-16 13:26 编辑
ocoipw 发表于 2023-6-15 20:45
(get_pline-vertexs et)
真心感谢你的无私回复，谢谢了:handshake 能不能这样啊
飞雪神光 发表于 2023-6-14 19:26
你好，代码很好，我是小白，请问这个用什么命令能调出来？能把这个直接改成画对角线吗？谢谢你了。
kzd2004 发表于 2023-7-26 14:04
你好，代码很好，我是小白，请问这个用什么命令能调出来？能把这个直接改成画对角线吗？谢谢你了。
命令就是TT
(defun c:tt (/ gr lmts loop p1 p2 p3 p4 pt s1 s2 s3 s4 screen ys yx zs zx)
(defun screen(/ c03 c08 c04 c05 c07 c06 c09 c01 c02);
(setq
c03 (trans (getvar "viewctr") 1 2)
c08 (getvar "viewsize")
c04 (getvar "screensize")
c09 (/ (* c08 (car c04)) (cadr c04))
c01 (list (- (car c03) (* 0.5 c09)) (- (cadr c03) (* 0.5 c08)))
c02 (list (+ (car c03) (* 0.5 c09)) (+ (cadr c03) (* 0.5 c08)))
c01 (trans c01 2 1)
c02 (trans c02 2 1)
)
(list c01 c02)
)
(setq loop t)
(while loop
(setq gr (grread t 15 0))
(cond
((= 5 (car gr))
(setq lmts (screen))
(setq pt (cadr gr))
(if(and
(setq S1 (ssget "F" (LIST pt (list (car pt) (cadadr lmts)))'((0 . "*line"))))
(setq S2 (ssget "F" (LIST pt (list (car pt) (cadarlmts)))'((0 . "*line"))))
(setq S3 (ssget "F" (LIST pt (list (caar lmts) (cadr pt)))'((0 . "*line"))))
(setq S4 (ssget "F" (LIST pt (list (caadr lmts)(cadr pt)))'((0 . "*line"))))
)
(progn
(setq P1 (trans (cadr(nth 3 (car (ssnamex S1)))) 0 1));上
(setq P2 (trans (cadr(nth 3 (car (ssnamex S2)))) 0 1));下
(setq P3 (trans (cadr(nth 3 (car (ssnamex S3)))) 0 1));左
(setq P4 (trans (cadr(nth 3 (car (ssnamex S4)))) 0 1));右
(setq
ys(list (car p4) (cadr p1))
yx(list (car p4) (cadr p2))
zx(list (car p3) (cadr p2))
zs(list (car p3) (cadr p1))
)
(redraw)
(grdraw zx zs 4)
(grdraw zs ys 4)
(grdraw ys yx 4)
(grdraw zx yx 4)
(grdraw zx ys 190)
(grdraw zs yx 190)
)
(redraw)
)
)
((= 3 (car gr))
(setq loop nil)
(redraw)
(entmake (list '(0 . "line")(cons 10 zx)(cons 11 ys)))
(entmake (list '(0 . "line")(cons 10 zs)(cons 11 yx)))
)
)
)
(princ)
)
飞雪神光 发表于 2023-7-26 14:46
命令就是TT
真诚的谢谢你啊！！！
本帖最后由 kzd2004 于 2023-8-12 07:44 编辑
飞雪神光 发表于 2023-7-26 14:46
命令就是TT
恳请大佬帮我改成这样的门开虚线，鼠标在左侧就是左开虚线，在右边就是右开虚线，谢谢你了。
(defun c:tt ()
"画矩形内部对角线"
(while (setq p0 (getpoint "\n拾取矩形内部点<退出>: "))
(bpoly p0)
(setq s1 (entlast))
(setq ptn (vl-remove-if '(lambda (x) (/= (car x) 10)) (entget s1))
ptn (mapcar 'cdr ptn)
)
(entdel s1)
(command "line" "non" (car ptn) "non" (caddr ptn) "")
(command "line" "non" (cadr ptn) "non" (cadddr ptn) "")
)
(princ)
)