Jhun Gonzalo Posted October 22, 2009 Posted October 22, 2009 Hi All, Good day to all, please if possible to have some Lisp Route that will automate to create a Rectangular DUCT Cutting Section as shown below attached image, by picking a 2 endpoints of rectang and create a shade solid hatch, similar with pipe cut (Yinyang) but on rectangular duct the shaded is on side portions only, advance thanks to all, Quote
Ajmal Posted June 14, 2023 Posted June 14, 2023 (defun c:crd (/ lt ename b c sn sn1 sn2 p1 p2 p3 p4 f d d1 d2 d3 a1 a2 a3 a4 p5 p6 p7 p8 p9 p10 sc ocl la ent lar ) (setq acdoc (vla-get-activedocument (vlax-get-acad-object)) acspc (vlax-get-property acdoc (if (= 1 (getvar 'CVPORT)) 'paperspace 'modelspace)) ) (command "cmdecho" (getvar "cmdecho")) (setq lt "center") (if (= (tblsearch "ltype" lt) nil) (command "-linetype" "l" lt "acad.lin" "") ) (setq ocl (getvar "clayer")) (princ "\n Select rectangles: ") (setq ss (ssget '((-4 . "<and") (0 . "LWPOLYLINE") (70 . 1) (90 . 4) (-4 . "and>") ) ) sn (sslength ss) sn1 sn )(COMMAND "UCS" "W" ) (repeat sn (setq sn2 (1- sn1) ename (ssname ss sn2) ent (entget ename) b (member (assoc 10 ent) ent) enlay (cdr(assoc 8 ent)) ) (while (member (assoc 10 b) b) (setq c (append c (list (cdr (assoc 10 b)))) b (cdr b) b (member (assoc 10 b) b) ) ) (setq f 0.0001 d 0.12 p1 (nth 0 c) p2 (nth 1 c) p3 (nth 2 c) p4 (nth 3 c) c nil d1 (/ (distance p1 p2) 2) d2 (/ (distance p2 p3) 2) d3 (if (> d1 d2) (* d1 0.12) (* d2 0.12) ) a1 (angle p1 p2) a2 (angle p2 p1) a3 (angle p2 p3) a4 (angle p3 p2) p5 (polar p1 a1 d1) p6 (polar p5 a4 d3) p7 (polar p6 a3 (+ (* d2 2) (* d3 2))) p8 (polar p2 a3 d2) p9 (polar p8 a1 d3) p10 (polar p9 a2 (+ (* d1 2) (* d3 2))) sc (* (+ d1 d2) f) sn1 sn2 ) (setq dis (lambda ( a1 b1 ) (distance (list (car a1) (cadr a1)) (list (car b1) (cadr b1)))) ocs (trans '(0.0 0.0 1.0) 1 0 t)) (setq ang(angle P4 p2) di (dis p2 p4) midp1(polar p4 ang (/ di 2)) di2(dis p4 midp1) midp2(polar p4 ang (/ di2 2))) (entmake (list '(000 . "LWPOLYLINE") '(100 . "AcDbEntity") '(100 . "AcDbPolyline") '(090 . 4) '(070 . 1) (cons 008 . (enlay)) (cons 010 (trans p1 1 ocs)) (cons 010 (trans midp2 1 ocs)) (cons 010 (trans p3 1 ocs)) (cons 010 (trans p4 1 ocs)) (cons 210 ocs) ) ) (setq crobj(entlast)) (setq hobj (vla-addhatch acspc achatchpatterntypepredefined "solid" :vlax-true achatchobject)) (vla-appendouterloop hobj (vlax-make-variant (vlax-safearray-fill (vlax-make-safearray vlax-vbobject '(0 . 0)) (list (vlax-ename->vla-object crobj)) ) ) ) (vla-evaluate hobj) (vla-put-color hobj 253) (vla-put-layer hobj enlay) ) (setvar "clayer" ocl)(COMMAND "UCS" "P") (princ) ) Quote
Recommended Posts
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.