求个交点插柱子的程序。自己试着编写，发现总是错误一大堆~~~
求个交点插柱子的程序。自己试着编写，发现总是错误一大堆，~~~要求插入柱子后，能将墙线剪掉，但不能伤着轴线~
要能支持acr墙线，我经常在arc墙线这里出错~
http://bbs.mjtd.com/forum.php?mod=attachment&aid=ODQxNDJ8ZWQ5ZDIyMTV8MTQwNjg5NTUzOXwyNTM4Mzd8MTEwOTA0&noupdate=yes
这个可以修剪，但是把轴线也修剪掉了。。(defun c:trex(/ p1 p2 ss ss1 ss2 lst1_e lst2_e lst p0 sn i n plst 2_es vla_e2
dxf10 dxf11 vla_e1 interp10 interp11 dist11 dist10 lst_dist10
lst_dist11 lst)
(vl-load-com)
(command "_.undo" "be")
(setq oldosmode (getvar "osmode"))
(setq oldorthomode (getvar "orthomode"))
(setvar "osmode" 0)
(setvar "cmdecho" 0)
(setvar "orthomode" 0)
(setq p11 (getpoint "\n请指定框选右下角："))
(setq p12(getcorner p11 "\n请框选要处理的所有物体:"))
;;;;;;;;;;;;;;;相交线剪切
(setq ss(ssget "c" p11 p12))
(setq ss2(ssget"p" '((-4 . "<and")(0 . "LINE")(8 . "梁")(-4 . "and>"))))
(ssget->list ss2)
(setq lst2_e lst)
(setq lst nil)
(setq ss(ssget "c" p11 p12))
(setq ss1(ssget "p" '((-4 . "<and")(0 . "*LINE")(-4 . "<or")(8 . "柱")(8 . "墙")(-4 . "or>")(-4 . "and>"))))
(ssget->list ss1)
(setq lst1_e lst)
(setq lst nil)
(setq n 0 i 0 )
(while (< n (length lst1_e))
(setq e(nth n lst1_e))
(setq s (entget e))
(setq plst (list))
(foreach x s (if (= (car x) 10) (setq plst (cons (cdr x) plst))
)
)
(setq p0(nth i plst))
(setq sn(car(nentselpp0)))
(while (=(cdr(assoc 8 (entget sn)))"梁")
(setq i (1+ i))
(setq p0(nth i plst))
(setq sn(car(nentselpp0)))
)
(qa sn)
(setq n (1+ n))
)
;;;;;;;;;;;;;;;;延伸无交点端点
(setq ss(ssget "c" p11 p12))
(setq ss2(ssget"p" '((-4 . "<and")(0 . "LINE")(8 . "梁")(-4 . "and>"))))
(ssget->list ss2)
(setq lst2_e lst)
(setq lst nil)
(setq ss(ssget "c" p11 p12))
(setq ss1(ssget"p" '((-4 . "<and")(0 . "*LINE")(-4 . "<or")(8 . "柱")(8 . "墙")(-4 . "or>")(-4 . "and>"))))
(ssget->list ss1)
(setq lst1_e lst)
(setq n 0m 0)
(repeat (length lst2_e)
(setq 2_es (entget (nth m lst2_e)))
(setq vla_e2(vlax-ename->vla-object (nth m lst2_e)))
(setq dxf10(cdr (assoc 10 2_es)))
(setq dxf11(cdr (assoc 11 2_es)))
(repeat (length lst1_e)
(setq vla_e1(vlax-ename->vla-object (nth n lst1_e)))
(setq interp10 (vlax-curve-getclosestpointto vla_e1 dxf10))
(setq dist10 (distance dxf10 interp10))
(setq interp11 (vlax-curve-getclosestpointto vla_e1 dxf11))
(setq dist11(distance dxf11interp11))
(setq lst_dist10 (cons (list interp10 dist10) lst_dist10))
(setq lst_dist11 (cons (list interp11 dist11) lst_dist11))
(setq n (1+ n))
)
(setq lst_dist10 (vl-sort lst_dist10 (function(lambda(x y) (< (cadr x)(cadr y))))))
(if (not(equal (cadar lst_dist10) 0.0))
(vla-put-startpoint vla_e2 (vlax-3d-point(caar lst_dist10)))
;(vla-update vla_e2)
)
(setq lst_dist11 (vl-sort lst_dist11 (function(lambda(x y) (< (cadr x)(cadr y))))))
(if (not(equal (cadar lst_dist11) 0.0))
(vla-put-endpoint vla_e2 (vlax-3d-point(caar lst_dist11)))
;(vla-update vla_e2)
)
(setq n 0)
(setq m(1+ m))
(setq lst_dist10 nil)
(setq lst_dist11 nil)
)
)
;;;;;;;;选择集转表
(defun ssget->list (ss / i ename )
(setq i -1)
(while (setq ename (ssname ss (setq i (1+ i))))
(setq lst (consename lst))
)
lst
)
;;;;;;;;;;;;;;界线剪切，xiaxiang源码，yjr111修改
(vl-load-com)
(defun to(n)
(cdr (assoc n (entget sn)))
)
(defun MODES (a)
(setq MLST '())
(repeat (length a)
(setq MLST (append MLST (list (list (car a) (getvar (car a))))))
(setq a (cdr a))
)
)
(defun MODER ()
(repeat (length MLST)
(setvar (caar MLST) (cadar MLST))
(setq MLST (cdr MLST))
)
)
(defun plpoint(/ en n ei );;求得PLINE线的各个顶点；
(setq en (entget sn)
n 0 lst '()
)
(while (/= (setq ei (nth n en)) nil)
(if (= (car ei) 10)
(setq lst (cons (cdr ei) lst))
)
(setq n (1+ n))
)
(setq lst (reverse lst)); lst (cons (last lst) lst))
(if (= (to 70) 1)(setq lst (cons (last lst) lst)))
(princ)
)
(defun meoffset (obj dst / tmplst)
(if (not (vl-catch-all-error-p (setq tmplst (vl-catch-all-apply 'vlax-invoke (list obj 'offset dst)))))
tmplst
)
)
(defun rjp-trimcircle (eg cen rad segs / cut el lst trim trim2 x cnt)
(setq cnt 0)
(repeat segs
(setq lst (cons (polar cen (+ 0 (* cnt (/ (* pi 2) segs))) rad)
lst
)
cnt (1+ cnt)
)
)
(setq lst (append lst (list (nth 0 lst))))
(if (setq trim (ssget "_f" lst))
(progn
(setq trim (vl-remove-if 'listp (mapcar 'cadr (ssnamex trim))))
(mapcar
'(lambda (x)
(setq el (entget x))
(if
(and (wcmatch (cdr (assoc 0 el))
"ARC,CIRCLE,LINE,*POLYLINE,SPLINE"
)
(/= 4
(cdr
(assoc
70
(entget
(tblobjname "layer" (cdr (assoc 8 el)))
)
)
)
)
)
(setq trim2 (cons x trim2))
)
)
trim
)
(if trim2
(progn
(setq cut (entmakex (list (cons 0 "CIRCLE")
(cons 10 cen)
(cons 40 rad)
)
)
)
(repeat 2
(mapcar
'(lambda (x)
(command "._trim" eg "" "f")
(apply 'command lst)
(command "" "")
)
trim2
)
)
(entdel cut)
)
)
)
)
(princ)
)
(defun qa( sn /str gr ga gb dist np0 p1 p2 s1 s2 lst el pt rad)
(command "undo" "g")
(modes '("cmdecho" "osmode" "pickbox" "APERTURE" ))
(setvar "cmdecho" 0)
(setvar "osmode" 0)
(setvar "pickbox" 5)
(setvar "APERTURE" 5)
(graphscr)
(setq n 0)
(setq dist 0.1 )
(if sn
(progn
(command "undo" "be")
(if (or (= (to 0) "LINE")(= (to 0) "LWPOLYLINE"))
(progn
(meoffset (vlax-ename->vla-object sn) dist)
(setq s1 sn sn (entlast))
;;;;;;判断多段线顺逆时针
(if (> (vla-get-length (vlax-ename->vla-object sn))
(vla-get-length (vlax-ename->vla-object s1)))
(progn
(vla-delete (vlax-ename->vla-object sn))
(meoffset (vlax-ename->vla-object s1) (* -1 dist))
(setq s1 sn sn (entlast))
)
)
(cond
((= "LINE" (to 0))
(setq p1 (to 10) p2 (to 11) lst (list p1 p2))
(command "trim" s1 "" "f" p1 p2 "" "")
(if (setq s2 (ssget "f" lst))(command "erase" s2 ""))
(command "erase" sn "")
)
((= "LWPOLYLINE" (to 0))
(plpoint)
(repeat 5
(command "trim" s1 "" "f" (foreach n lst (command n) "" ) "")
)
(if (setq s2 (ssget "f" lst))(command "erase" s2 ""))
;;;;;;;;;;删除框内遗留线段
(if (setq s2 (ssget "wp" lst))
(progn
(setq n 0)
(repeat (sslength s2)
(vla-delete (vlax-ename->vla-object (ssnames2 n)))
(setq n(1+ n))
)
)
)
)
)
(command "undo" "e")
(setq n (+ n 1))
)
)
(moder)
(command "undo" "e")
(princ)
)
)
)
我要的是插入一个柱子自动剪掉一个柱子里面的墙线 用交点打断，而不用修剪。
思路是矩形PL点表选择墙线，过滤掉轴线，计算交点，打断，缩放视图到矩形，再用wp选择矩形内的实体，删除。
应该也可以用(redraw ent 2) 柱内打断删除:
超级EXTRIM
永远强大 让人崇拜的院长大人 一个小提醒：在批量打断（剪裁）的时候，被打断的实体是可能会变化的。
页:
[1]
2