新人求助，关于框选连线，麻烦各位老师帮忙
本帖最后由 龙幽小蛮 于 2014-8-5 07:36 编辑在论坛里找到许多自动连线的程序，能否能不能有老师帮我改一下，最近的每24个左右连成一串（不超过26），然后线通过块的时候最好能断开，先谢过各位老师，让我也学习下LISP。 (defun c:tt(/ os ss pl p1 p2)
(setq os (getvar 'osmode))
(setvar 'osmode 0)
(setq ss (ssget '((0 . "insert"))))
(if ss
(progn
(setq pl (GXL-GETSSBOX ss)
p1 (car pl)
p2 (cadr pl)
ss (GXL-SEL-SS->LIST ss)
)
;;;此处画一个圆，图块投影到园上排序
(command "_pline" p1 "a" "s" (list (car p1) (cadr p2)) p2 "s" (list (car p2) (cadr p1)) p1 "")
(setq en (entlast))
(setq ss (vl-sort ss '(lambda (a b)
(< (vlax-curve-getParamAtPoint en (vlax-curve-getclosestpointto en (gxl-dxf a 10)))
(vlax-curve-getParamAtPoint en (vlax-curve-getclosestpointto en (gxl-dxf b 10)))
)
)
)
)
(command "_pline")
(mapcar 'command (mapcar '(lambda (X) (gxl-dxf x 10)) ss))
(command "")
(entdel en)
)
)
(setvar 'osmode os)
(princ)
)
;; gxl-GetssBox 取得选择集的实体外矩形框
(defun gxl-GetssBox (ss / maxpt maxptlst minpt minptlst obj x ss1)
(setq ss1 (gxl-Sel-SS->List ss))
(foreach x ss1
(setq obj (vlax-ename->vla-object x))
;(setq minPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
;(setq maxPt (vlax-make-safearray vlax-vbdouble '(0 . 2)))
(vla-GetBoundingBox Obj 'minpt 'maxpt) ; 得到包围框
(setq minPt (vlax-safearray->list minPt))
(setq maxPt (vlax-safearray->list maxPt))
(setq minPtlst (append minPtlst (list minPt)))
(setq maxPtlst (append maxPtlst (list maxPt)))
) ;_ 结束foreach
(setq minPt (list (apply 'min (mapcar 'car minPtlst))
(apply 'min (mapcar 'cadr minPtlst))
0
) ;_ 结束list
) ;_ 结束setq
(setq maxPt (list (apply 'max (mapcar 'car maxPtlst))
(apply 'max (mapcar 'cadr maxPtlst))
0
) ;_ 结束list
) ;_ 结束setq
;(command "rectang" minPt maxPt)
(list minPt maxPt)
) ;_ 结束defun
(defun gxl-Sel-SS->List (ss / i s )
(if ss
(repeat (setq i (sslength ss))
(setq s (cons (ssname ss (setq i (1- i))) s))
)
)
)
;;;==================================================================
;;;(gxl-dxf ent i )取出像素索引i对应的值
;;;==================================================================
(defun gxl-dxf (ent i)
(cond ((= (type ent) 'ename)
(cdr (assoc i (entget ent)))
)
((= (type ent) 'list)
(cdr (assoc i ent))
)
) ;_ if
)
试试这看看
忘记是哪位大师做的,取之明经cad,用之明经
song宋_74729 发表于 2022-6-21 15:39
(defun c:tt(/ os ss pl p1 p2)
(setq os (getvar 'osmode))
(setvar 'osmode 0)
贱人里也有这个，原创哪位就不清楚了。 本帖最后由 ZZXXQQ 于 2014-8-5 21:38 编辑
(defun c:tt ()
(vl-load-com)
(setq bnm (assoc 2 ent))
(if (and (princ "\n选择图块: ") (setq ss (ssget (list '(0 . "INSERT")))))
(if (and (setq s1 (entsel "\n选择起点块: "))
(setq ent (entget(car s1)))
(= (cdr(assoc 0 ent)) "INSERT")) (progn
(ssdel (car s1) ss)
(setq enl (list))
(repeat (setq i (sslength ss))
(setq enl (cons (ssname ss (setq i (1- i))) enl))
)
(setq en (car s1))
(vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
(setq p1 (vlax-safearray->list p1) p2 (vlax-safearray->list p2))
(setq pm (mapcar '(lambda (a b) (/ (+ a b) 2)) p1 p2))
(setq pena (list pm p1 p2 en))
(setq penl (list))
(foreach en enl
(vla-getboundingbox (vlax-ename->vla-object en) 'p1 'p2)
(setq p1 (vlax-safearray->list p1) p2 (vlax-safearray->list p2))
(setq pm (mapcar '(lambda (a b) (/ (+ a b) 2)) p1 p2))
(setq penl (cons (list pm p1 p2 en) penl))
)
(setq i 0)
(setq tmpl (list))
(while (> (length penl) 1)
(setq disl (mapcar '(lambda (a) (distance (car pena) (car a))) penl))
(setq dpenl (mapcar 'cons disl penl))
(setq dpenl (vl-sort dpenl '(lambda (a b) (> (car a) (car b)))))
(setq tmpl (cons (cdar dpenl) tmpl))
(setq penl (mapcar 'cdr (cdr dpenl)) penl (cdr penl))
(setq i (1+ i))
)
(setq penl tmpl)
(setq pe pena)
(foreach pen penl
(entmake (list '(0 . "LINE") (cons 10 (car pe)) (cons 11 (car pen))))
(setq pe pen)
)
(foreach pen penl
(command "_.RECTANG" (cadr pen) (caddr pen))
(setq s2 (entlast))
(command "_.TRIM" s2 "" "F" (car pen) (list (caar pen) (cadadr pen)) "" "")
(command "_.ERASE" s2 "")
)
))
)
(princ)
)
本帖最后由 龙幽小蛮 于 2014-8-5 09:21 编辑
ZZXXQQ 发表于 2014-8-5 08:54 static/image/common/back.gif
咦,谢谢这位老师,我说明大概不清楚,只是24个块框选连线,不是指定一个块.程序貌似有问题,"参数类型错误: lentityp (0 (23575.1 42457.9 0.0))",这是有问题吧?谢谢,谢谢
本帖最后由 王与韩1 于 2014-8-5 16:29 编辑
一看就是同行啊,顶这个问题.不过ZZXXQQ大师的程序我用不了,又能顺便学习了~ 自顶~来点人吧 本帖最后由 xyp1964 于 2024-3-11 22:54 编辑
;; 需要e派工具箱的支持，慎用！
xyp1964 发表于 2014-8-5 21:04 static/image/common/back.gif
额，没两个币，怎么得啊T_T ZZXXQQ 发表于 2014-8-5 08:54 static/image/common/back.gif
老师，回家不知道怎么又能用了，可是怎么连线连不完啊。5个连3个，4个连2个...麻烦老师看下嘛
本帖最后由 王与韩1 于 2014-8-5 22:41 编辑
xyp1964 发表于 2014-8-5 21:04 static/image/common/back.gif
院长，有E派工具箱怎么还是说“no function definition: XYP-CMDLA0”... 自顶,ZZXXQQ老师和xyp1964老师再来帮帮吧