帮忙编个cad lisp命令
功能:框选一下,里面有多条线,运行命令后所有交点的坐标就能知道。我自己在练习编个程序,上面说的这歩实现不了了...
功能:框选一下,里面有多条线,运行命令后所有交点的坐标就能知道。
我自己在练习编个程序,上面说的这歩实现不了了 展开
我自己在练习编个程序,上面说的这歩实现不了了 展开
2个回答
展开全部
参见http://bbs.mjtd.com/thread-26793-1-1.html
我增加一处: (vl-load-com)
(defun GetInterPoint (ent1 ent2 / intpoints points i) (setq intpoints (vla-intersectwith ent1 ent2 acextendnone))
(setq intpoints (vlax-variant-value intpoints))
(setq i 0)
(if (> (vlax-safearray-get-u-bound intpoints 1) 0)
(repeat (/ (+ 1
(- (vlax-safearray-get-u-bound intpoints 1)
(vlax-safearray-get-l-bound intpoints 1)
)
)
3
)
(setq points (append points (list (list
(vlax-safearray-get-element intpoints i)
(vlax-safearray-get-element intpoints (+ i 1))
(vlax-safearray-get-element intpoints (+ i 2))
)))
)
(setq i (+ 3 i))
)
)
points
) (defun c:main( / ss n i j ent1 ent2 points)
(setq ss (ssget))
(if ss
(setq n (sslength ss))
)
(setq i 0 j 0)
(while (< i n)
(setq j (1+ i))
(setq ent1 (ssname ss i))
(vl-load-com)
(setq ent1 (vlax-ename->vla-object ent1))
(while (< j n)
(setq ent2 (ssname ss j))
(setq ent2 (vlax-ename->vla-object ent2))
(setq points (append points (getinterpoint ent1 ent2)))
(setq j (1+ j))
)
(setq i (1+ i))
)
(Princ points)
(princ (strcat "\n共有交点" (itoa (length points)) "?"))
(princ)
)
以上程序不能显示一条PLINE线自身的交点, 下面的程序可以显示一条PLINE线自身所有的交点
(defun w_pl_lst (ent / pl_list elv pnt pnt1 ent)
(setq pl_list nil)
(if (= (cdr (assoc 38 ent)) nil)
(setq elv 0.0)
(setq elv (cdr (assoc 38 ent)))
)
(foreach rec ent
(if (= (car rec) 10)
(progn
(setq pnt (cdr rec))
(setq pnt1 (list pnt))
(setq pl_list (append
pnt1
pl_list
)
)
)
)
)
pl_list
)
(defun c:test (/ cout ent_obj outlist dlist elist clist b nleng)
(setq count 1)
(setq clist (list "角点" "X坐标" "Y坐标"))
(PRINC " OK1 ")
(while (setq b (entsel "\n请选择一条多义线"))
(setq ent_obj (entget (car b)))
(setq outlist (w_pl_lst ent_obj))
(setq dlist (append
dlist
outlist
)
)
)
(setq nleng (length dlist))
(repeat nleng
(setq elist (append
elist
(list (itoa count))
)
)
(setq count (1+ count))
)
(setq outlist (mapcar
'cons
elist
dlist
)
)
(setq outlist (append
(list clist)
outlist
)
)
(PRINC outlist)
)
我增加一处: (vl-load-com)
(defun GetInterPoint (ent1 ent2 / intpoints points i) (setq intpoints (vla-intersectwith ent1 ent2 acextendnone))
(setq intpoints (vlax-variant-value intpoints))
(setq i 0)
(if (> (vlax-safearray-get-u-bound intpoints 1) 0)
(repeat (/ (+ 1
(- (vlax-safearray-get-u-bound intpoints 1)
(vlax-safearray-get-l-bound intpoints 1)
)
)
3
)
(setq points (append points (list (list
(vlax-safearray-get-element intpoints i)
(vlax-safearray-get-element intpoints (+ i 1))
(vlax-safearray-get-element intpoints (+ i 2))
)))
)
(setq i (+ 3 i))
)
)
points
) (defun c:main( / ss n i j ent1 ent2 points)
(setq ss (ssget))
(if ss
(setq n (sslength ss))
)
(setq i 0 j 0)
(while (< i n)
(setq j (1+ i))
(setq ent1 (ssname ss i))
(vl-load-com)
(setq ent1 (vlax-ename->vla-object ent1))
(while (< j n)
(setq ent2 (ssname ss j))
(setq ent2 (vlax-ename->vla-object ent2))
(setq points (append points (getinterpoint ent1 ent2)))
(setq j (1+ j))
)
(setq i (1+ i))
)
(Princ points)
(princ (strcat "\n共有交点" (itoa (length points)) "?"))
(princ)
)
以上程序不能显示一条PLINE线自身的交点, 下面的程序可以显示一条PLINE线自身所有的交点
(defun w_pl_lst (ent / pl_list elv pnt pnt1 ent)
(setq pl_list nil)
(if (= (cdr (assoc 38 ent)) nil)
(setq elv 0.0)
(setq elv (cdr (assoc 38 ent)))
)
(foreach rec ent
(if (= (car rec) 10)
(progn
(setq pnt (cdr rec))
(setq pnt1 (list pnt))
(setq pl_list (append
pnt1
pl_list
)
)
)
)
)
pl_list
)
(defun c:test (/ cout ent_obj outlist dlist elist clist b nleng)
(setq count 1)
(setq clist (list "角点" "X坐标" "Y坐标"))
(PRINC " OK1 ")
(while (setq b (entsel "\n请选择一条多义线"))
(setq ent_obj (entget (car b)))
(setq outlist (w_pl_lst ent_obj))
(setq dlist (append
dlist
outlist
)
)
)
(setq nleng (length dlist))
(repeat nleng
(setq elist (append
elist
(list (itoa count))
)
)
(setq count (1+ count))
)
(setq outlist (mapcar
'cons
elist
dlist
)
)
(setq outlist (append
(list clist)
outlist
)
)
(PRINC outlist)
)
追问
谢谢,好难啊。我还是不自己编了,我最终的目标是要这样:http://zhidao.baidu.com/question/1795620407990858507.html?quesup2&oldq=1,你知道怎么样写吗?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询