(setq ss (ssget "X"))
(setq pli (ssnamex ss))
(setq li (list))
(foreach a pli
(setq li
(append li
(list (cadr a))
)
)
)
(setq ali (list))
(foreach o li
(setq ali
(append ali
(list (entnext o))
)
)
)
(setq oli (list))
(foreach ob ali
(setq oli
(append oli
(list (cdr (assoc 1 (entget ob))))
)
)
)
(setq cli (list))
(foreach c li
(setq cli
(append cli
(list (cdr (assoc 10 (entget c))))
)
)
)
(setq cnt 0)
(setq fli (list))
(while (/= cnt (length cli))
(setq fli
(append fli
(list (cons (nth cnt oli) (nth cnt cli)))
)
)
(setq cnt (1+ cnt))
)
(setq slist (getstring t "\nEnter imovable limit point numbers: "))
(setq lst (list))
(while (setq pt (vl-string-search " " slist))
(setq lst (cons (substr slist 1 pt) lst))
(setq slist (substr slist (+ pt 2)))
)
(setq lst (reverse (cons slist lst)))
(setq als (list)
cnt 0
)
(while (/= cnt (length lst))
(foreach a fli
(setq als
(append als
(if (= (nth cnt lst) (car a))
(list (cons 10 (cdr a)))
)
)
)
)
(setq cnt (1+ cnt))
)
(setq vn (length als))
(setq adl (list '(0 . "LWPOLYLINE")
'(100 . "AcDbEntity")
'(100 . "AcDbPolyline")
(cons 90 vn)
'(70 . 1)
)
adf (list '(210 0.0 0.0 1.0))
enlist (append adl als)
enlist (append enlist adf)
)
(entmake enlist)
(princ)
)
干得好!您必须输入“imli”以启动命令,然后系统会提示您输入定义不可移动极限的点号,您应该以“n1 n2 n3”的形式输入点号,不带引号,并且在它们之间留有空格!如果你有任何问题,请随时提问!顺便说一句,它根本没有调试,因此如果您在图形中有一条多段线,您将遇到一些困难,因此最好在执行命令时更改图层并冻结多段线图层!
关于CAD_89! CODE removed
HTH公司 这不是我想要的。。。。。。。。。。。
我运行命令imli然后问我
输入移动极限点编号:
然后我给出一个数字10
把信息打印出来
将顶点添加到只有一个顶点的二维样条线(0)。
; 错误:错误的参数类型:lentyp nil
--------------------------------------------------------------
我要求用lisp从属性块到属性块绘制直线,只给出点代码号
例如
从点1到2到3到4。。。。。。。。。
或
从点S1到S2到S3到S4。。。。。。。。。
或
从T1点到T2点到T3点到T4点。。。。。。。。。
或
从点K1到K2到K3到K4。。。。。。。。。
或任何其他(带字母的数字或带数字的字母)(1a、1a、1b、1b….、A1、A1、B1、B1)
见图纸topo。我已在post 1上传图纸 是的,因为正如我在第一篇帖子中所说的那样,你必须输入它们,每个都用空格隔开,例如
输入iMoved极限点号:12 13 14 15 1 32(注意,它们由空格12 space 13 space 14 space等分隔),然后按Enter键。 我会尽量多帮一点
我有这个旧代码,但不使用块属性。。。。。。有人能转换吗
(defun c:ll(/ point1 point11 ss1 ent1 listent xy1
point2 point22 ss2 ent2 listen2 xy2)
(SetVar "cmdecho" 0);
(SetQ point1 (getstring " give the number or the name of the point ? "))
(SetQ point11 (strcat point1 ))
(if (= point11 "")
(progn
(princ "\n")
(SetQ xy1 (getpoint "from point "))
(command "line" xy1)
)
(progn
;(command "time" "d" "")
;(SetQ qqq (ssget "X" (list (cons 0 "TEXT"))))
;(SetQ www (sslength qqq))
;(print www)
;(command "time" "d" "")
(SetQ ss1 (ssget "X" (list (cons 0 "TEXT") (cons 1 point11) (cons 8 "labels"))))
(SetQ ent1 (ssname ss1 0))
(SetQ listent (entget ent1))
(SetQ xy1 (cdr (assoc 11 listent))) ;find x1,y1
;
;
(command "line" xy1 )
)
)
(while (/= xy1 nil)
(SetQ point2 (getstring "to point ? "))
(SetQ point22 (strcat point2 ))
;
(if (= point22 "")
(progn
(princ "\n")
(SetQ xy2 (getpoint "to point "))
(command xy2)
)
(progn
(SetQ ss2 (ssget "X" (list (cons 0 "TEXT") (cons 1 point22) (cons 8 "labels"))))
;
(SetQ ent2 (ssname ss2 0))
(SetQ listent2 (entget ent2))
(SetQ xy2 (cdr (assoc 11 listent2))) ;find x2,y2
;;
;;
(command xy2 )
)
)
(= (SetQ xy1 xy2)) ;reverse xy1 me xy2
)
)
:投降:等等,对不起,我认为它有效。等一分钟再检查一下。。。。。。。。。。 直线。lsp的工作很好,但我需要看到从一点到另一点的线,而不是看到最后的所有线。。。。。。。。。。。(避免出错)
页:
1
[2]