Jump to content

Symbol for Duct Cutting section


Recommended Posts

Posted

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,

DUCT SECTION.jpg

  • 13 years later...
Posted

(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)
)

 

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.

Guest
Unfortunately, your content contains terms that we do not allow. Please edit your content to remove the highlighted words below.
Reply to this topic...

×   Pasted as rich text.   Restore formatting

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • Create New...