Automatic Trim
Accepted solution
Here is my last attempt on this subject. This one required a lots of code changes and testing.
Attempt with breaking entities at point of wall column joint using break command failed miserably. Some other methods also didn't work or result was way too bad. At the end, with using various sorting and conditionals I've finished with this code. In some situations it works flawlessly, in other there can be some non erased or wrongly erased entity belonging to columns. Code is a bit generalized so it asks to select some entities to extract layer name for columns (so other users can use it). After code execution, all entities remain in its particular layer.
Requires that columns and walls are drawn in separate layer.
(defun c:efes_pilsner
;CREATED:Sunday, September 12, 2021
;VERSION 0.95)
;Author: hak_vz
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;Posted at
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/automatic-trim/m-p/10616848/highlight/true#M420301
;Erases unwanted segments on column wall joints
;Requires columns and walls entities to be drawn in separate layers
( / *error* take pointlist2d collinear unique adoc p1 p2 ss_kol ss_wall i j k e eo wo
tp pointlist delpoint points_on_column np pts seglist s1 s2 onseg ss_del
testpoints be bo le re mpt col_layer pick_poly ss
);
(defun *error* ( msg )
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ)
)
(if (and adoc) (vla-endundomark adoc))
(setvar 'cmdecho 1)
(princ)
)
(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
(defun pointlist2d (lst / ret) (while lst (setq ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))
(defun collinear (p1 p2 p3)(setq a (angle p1 p2) b (angle p1 p3) c (angle p3 p1) d (angle p3 p2))(or (= a b)(= a c) (= a d) (= b a) (= b c) (= b d)))
(defun unique (lst)(if lst (cons (car lst) (unique (vl-remove (car lst) (cdr lst))))))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark adoc)
(vla-startundomark adoc)
(defun pick_poly (msg)
(setq e (car(entsel (strcat "\n" msg " >"))))
(if (and (not e) (= (getvar 'Errno) 7)) (pick_poly) e)
)
(princ "\nEnclose all entities with window selection picking two external points!")
(setq p1 (getpoint "\nPick first window selection point >") p2 (getcorner p1 "\nSelect second window selection point >"))
(setq col_layer (cdr (assoc 8 (entget(pick_poly "Select some COLUMN entity to extract columns layername >")))))
(cond
((and p1 p2)
(setvar 'cmdecho 0)
(command "_.zoom" "_w" p1 p2)
(setq ss (ssget "_W" p1 p2 '((0 . "LINE"))))
(cond (and ss)
(command "_.pedit" "M" ss "" "Y" "" "")
)
(setq ss_kol (ssget "_W" p1 p2 (list (cons 0 "LWPOLYLINE")(cons 8 col_layer))))
(cond
((/= (rem (sslength ss_kol) (/ (sslength ss_kol) 4.0)) 0.0)
(princ "\nNumber of column edges is not rigth >")
)
(T
(initcommandversion)
(command "_.join" ss_kol "")
)
)
(mapcar 'set '(p1 p2) (vl-sort (list p1 p2) '(lambda (x y) (< (car x)(car y)))))
(setq ss_kol (ssget "_W" p1 p2 (list (cons 0 "LWPOLYLINE")(cons 8 col_layer))))
(setq i -1)
(while (<(setq i (1+ i)) (sslength ss_kol))
(setq e (ssname ss_kol i) eo (vlax-ename->vla-object e))
(vla-GetBoundingBox eo '_min '_max)
(mapcar 'set '(_min _max) (mapcar 'vlax-safearray->list (list _min _max)))
(mapcar 'set '(x1 y1) _min)
(mapcar 'set '(x2 y2) _max)
(if (and _min _max)
(vlax-put eo 'Coordinates (apply 'append (list (list x1 y1)(list x2 y1)(list x2 y2)(list x1 y2))))
)
(setq testpoints (cons _min testpoints))
)
(setq tp (car (vl-sort testpoints '(lambda (x y) (< (distance p1 x)(distance p1 y))))))
(command "_.rectang" p1 p2)
(setq re (entlast))
(command "_.line" p1 tp "")
(setq le (entlast))
(setq tp (mapcar '* (mapcar '+ p1 tp) '(0.5 0.5)))
(setq tp (polar tp (- (angle tp p1) (- PI 2)) 0.05))
(command "_.boundary" "_none" tp "")
(setq be (entlast) bo (vlax-ename->vla-object be))
(entdel le)
(entdel re)
(setq ss_wall (ssget "_W" p1 p2 '((0 . "LWPOLYLINE")(-4 . "=")(70 . 0))))
(setq i -1)
(while (<(setq i (1+ i)) (sslength ss_wall))
(setq e (ssname ss_wall i))
(setq wo (vlax-ename->vla-object e))
(setq pointlist (cons (vlax-curve-getStartPoint wo) pointlist))
(setq pointlist (cons (vlax-curve-getEndPoint wo) pointlist))
)
(setq pointlist (unique pointlist))
(command "_.move" ss_wall "" p1 (mapcar '- p1 '(1000000 0)))
(setq i -1)
(setq delpoint nil)
(while (<(setq i (1+ i)) (sslength ss_kol))
(setq k (ssname ss_kol i) ko (vlax-ename->vla-object k))
(setq points_on_column nil)
(foreach ept pointlist
(if (<= (distance (setq np(vlax-curve-getClosestPointTo ko ept nil)) ept) 1e-3)
(setq points_on_column (cons (take 2 np) points_on_column))
)
)
(cond
((and points_on_column)
(setq pts (pointlist2d (vlax-get ko 'Coordinates)))
(setq pts (append pts (list (car pts))))
(setq j -1 seglist nil)
(while (< (setq j (1+ j)) (1- (length pts)))
(setq seglist (cons (list (nth j pts) (nth (1+ j) pts)) seglist))
)
(foreach seg seglist
(setq s1 (car seg) s2 (cadr seg) onseg nil)
(foreach pt points_on_column
(cond
((collinear s1 s2 pt)
(setq onseg (cons pt onseg))
)
)
)
(cond
((and onseg (= (length onseg) 2))
(setq delpoint (cons (mapcar '* (mapcar '+ (car onseg) (cadr onseg)) '(0.5 0.5)) delpoint))
)
)
)
(setq pts (append pts points_on_column))
(setq pts (apply 'append(vl-sort pts '(lambda (x y)(< (vlax-curve-getDistAtPoint ko x)(vlax-curve-getDistAtPoint ko y))))))
(vlax-put ko 'Coordinates pts)
)
)
)
(initcommandversion)
(command "_.explode" ss_kol "")
(setq ss_kol (ssget "_W" p1 p2 (list (cons 0 "LINE")(cons 8 col_layer))))
(command "_.pedit" "m" ss_kol "" "Y" "")
(setq ss_kol (ssget "_W" p1 p2 (list (cons 0 "LWPOLYLINE")(cons 8 col_layer))))
(setq i -1)
(setq ss_del (ssadd))
(while (<(setq i (1+ i)) (sslength ss_kol))
(setq k (ssname ss_kol i) ko (vlax-ename->vla-object k))
(setq mpt (mapcar '* (mapcar '+ (vlax-curve-getStartPoint ko)(vlax-curve-getEndPoint ko)) '(0.5 0.5)))
(foreach ept delpoint
(if (and
(<= (distance (setq np(vlax-curve-getClosestPointTo ko ept nil)) ept) 1e-4)
(> (distance mpt(vlax-curve-getClosestPointTo bo mpt nil)) 1e-14)
)
(setq ss_del (ssadd k ss_del))
)
)
)
(initcommandversion)
(command "_.erase" ss_del "")
(command "_.move" ss_wall "" p1 (mapcar '- p1 '(-1000000 0)))
(entdel be)
)
)
(setvar 'cmdecho 1)
(vla-endundomark adoc)
(princ "\nDone!")
(princ "\nCheck drawing for possibly non erased or wrongly erased entities at columns and walls joints!")
(princ)
)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Usage is simple. Start command, pick two points outside all entities to create window selection, pick an entity (a polyline) on columns layer to extract name of layer and that's it. Sorry don't have time to work on video.
After final editing i.e erase or add some column member (all breaking points are correct, but sampling right entity to erase is complex and may fail in some case
Failure at the end are result of algorithm complexity and potential errors, too many variables involved and conditions to test and Murphy's law.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
Sorry can not replicate your error. Here is a bit changed code (it doesn't move wall layer entities aside). Try this. if failed attach your failed drawing sample (after you run code). From your attached image it looks like code breaks at some stage on your computer and doesn't perform all action i.e not all actions are done.
(defun c:efes_pilsner
;CREATED:Sunday, September 12, 2021
;VERSION 0.95
;Author: hak_vz
;https://forums.autodesk.com/t5/user/viewprofilepage/user-id/5530556
;Posted at
;https://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/automatic-trim/m-p/10616848/highlight/true#M420301
;Erases unwanted segments on column wall joints
;Requires columns and walls entities to be drawn in separate layers
( / *error* take pointlist2d collinear unique adoc p1 p2 ss_kol ss_wall i j k e eo wo
tp pointlist delpoint points_on_column np pts seglist s1 s2 onseg ss_del
testpoints be bo le re mpt col_layer pick_poly ss
);
(defun *error* ( msg )
(if (not (member msg '("Function cancelled" "quit / exit abort")))
(princ)
)
(if (and adoc) (vla-endundomark adoc))
(setvar 'cmdecho 1)
(princ)
)
(defun take (amount lst / ret)(repeat amount (setq ret (cons (car lst) (take (1- amount) (cdr lst))))))
(defun pointlist2d (lst / ret) (while lst (setq ret (cons (take 2 lst) ret) lst (cddr lst))) (reverse ret))
(defun collinear (p1 p2 p3)(setq a (angle p1 p2) b (angle p1 p3) c (angle p3 p1) d (angle p3 p2))(or (= a b)(= a c) (= a d) (= b a) (= b c) (= b d)))
(defun unique (lst)(if lst (cons (car lst) (unique (vl-remove (car lst) (cdr lst))))))
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
(vla-endundomark adoc)
(vla-startundomark adoc)
(defun pick_poly (msg)
(setq e (car(entsel (strcat "\n" msg " >"))))
(if (and (not e) (= (getvar 'Errno) 7)) (pick_poly) e)
)
(princ "\nEnclose all entities with window selection picking two external points!")
(setq p1 (getpoint "\nPick first window selection point >") p2 (getcorner p1 "\nSelect second window selection point >"))
(setq col_layer (cdr (assoc 8 (entget(pick_poly "Select some COLUMN entity to extract columns layername >")))))
(cond
((and p1 p2)
(setvar 'cmdecho 0)
(command "_.zoom" "_w" p1 p2)
(setq ss (ssget "_W" p1 p2 '((0 . "LINE"))))
(cond (and ss)
(command "_.pedit" "M" ss "" "Y" "" "")
)
(setq ss_kol (ssget "_W" p1 p2 (list (cons 0 "LWPOLYLINE")(cons 8 col_layer))))
(cond
((/= (rem (sslength ss_kol) (/ (sslength ss_kol) 4.0)) 0.0)
(princ "\nNumber of column edges is not rigth >")
)
(T
(initcommandversion)
(command "_.join" ss_kol "")
)
)
(mapcar 'set '(p1 p2) (vl-sort (list p1 p2) '(lambda (x y) (< (car x)(car y)))))
(setq ss_kol (ssget "_W" p1 p2 (list (cons 0 "LWPOLYLINE")(cons 8 col_layer))))
(setq i -1)
(while (<(setq i (1+ i)) (sslength ss_kol))
(setq e (ssname ss_kol i) eo (vlax-ename->vla-object e))
(vla-GetBoundingBox eo '_min '_max)
(mapcar 'set '(_min _max) (mapcar 'vlax-safearray->list (list _min _max)))
(mapcar 'set '(x1 y1) _min)
(mapcar 'set '(x2 y2) _max)
(if (and _min _max)
(vlax-put eo 'Coordinates (apply 'append (list (list x1 y1)(list x2 y1)(list x2 y2)(list x1 y2))))
)
(setq testpoints (cons _min testpoints))
)
(setq tp (car (vl-sort testpoints '(lambda (x y) (< (distance p1 x)(distance p1 y))))))
(command "_.rectang" p1 p2)
(setq re (entlast))
(command "_.line" p1 tp "")
(setq le (entlast))
(setq tp (mapcar '* (mapcar '+ p1 tp) '(0.5 0.5)))
(setq tp (polar tp (- (angle tp p1) (- PI 2)) 0.05))
(command "_.boundary" "_none" tp "")
(setq be (entlast) bo (vlax-ename->vla-object be))
(entdel le)
(entdel re)
(setq ss_wall (ssget "_W" p1 p2 '((0 . "LWPOLYLINE")(-4 . "=")(70 . 0))))
(setq i -1)
(while (<(setq i (1+ i)) (sslength ss_wall))
(setq e (ssname ss_wall i))
(setq wo (vlax-ename->vla-object e))
(setq pointlist (cons (vlax-curve-getStartPoint wo) pointlist))
(setq pointlist (cons (vlax-curve-getEndPoint wo) pointlist))
)
(setq pointlist (unique pointlist))
(setq i -1)
(setq delpoint nil)
(while (<(setq i (1+ i)) (sslength ss_kol))
(setq k (ssname ss_kol i) ko (vlax-ename->vla-object k))
(setq points_on_column nil)
(foreach ept pointlist
(if (<= (distance (setq np(vlax-curve-getClosestPointTo ko ept nil)) ept) 1e-3)
(setq points_on_column (cons (take 2 np) points_on_column))
)
)
(cond
((and points_on_column)
(setq pts (pointlist2d (vlax-get ko 'Coordinates)))
(setq pts (append pts (list (car pts))))
(setq j -1 seglist nil)
(while (< (setq j (1+ j)) (1- (length pts)))
(setq seglist (cons (list (nth j pts) (nth (1+ j) pts)) seglist))
)
(foreach seg seglist
(setq s1 (car seg) s2 (cadr seg) onseg nil)
(foreach pt points_on_column
(cond
((collinear s1 s2 pt)
(setq onseg (cons pt onseg))
)
)
)
(cond
((and onseg (= (length onseg) 2))
(setq delpoint (cons (mapcar '* (mapcar '+ (car onseg) (cadr onseg)) '(0.5 0.5)) delpoint))
)
)
)
(setq pts (append pts points_on_column))
(setq pts (apply 'append(vl-sort pts '(lambda (x y)(< (vlax-curve-getDistAtPoint ko x)(vlax-curve-getDistAtPoint ko y))))))
(vlax-put ko 'Coordinates pts)
)
)
)
(initcommandversion)
(command "_.explode" ss_kol "")
(setq ss_kol (ssget "_W" p1 p2 (list (cons 0 "LINE")(cons 8 col_layer))))
(command "_.pedit" "m" ss_kol "" "Y" "")
(setq ss_kol (ssget "_W" p1 p2 (list (cons 0 "LWPOLYLINE")(cons 8 col_layer))))
(setq i -1)
(setq ss_del (ssadd))
(while (<(setq i (1+ i)) (sslength ss_kol))
(setq k (ssname ss_kol i) ko (vlax-ename->vla-object k))
(setq mpt (mapcar '* (mapcar '+ (vlax-curve-getStartPoint ko)(vlax-curve-getEndPoint ko)) '(0.5 0.5)))
(foreach ept delpoint
(if (and
(<= (distance (setq np(vlax-curve-getClosestPointTo ko ept nil)) ept) 1e-4)
(> (distance mpt(vlax-curve-getClosestPointTo bo mpt nil)) 1e-14)
)
(setq ss_del (ssadd k ss_del))
)
)
)
(initcommandversion)
(command "_.erase" ss_del "")
(entdel be)
)
)
(setvar 'cmdecho 1)
(vla-endundomark adoc)
(princ "\nDone!")
(princ "\nCheck drawing for possibly non erased or wrongly erased entities at columns and walls joints!")
(princ)
)
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
The reason that my first code didn't work for you has moved me to started working on this code. At the end I needed to use bpoly to create outside wall boundary (unable to remove elements from outer column side to be erased.
Option would be to draw outer wall edge as closed polyline and select it as a boundary. In that case bpoly is not needed. First of all you have to check your installation.
Miljenko Hatlak
Did your question get successfully answered? Then click on the ACCEPT SOLUTION button.
