Lisp For DRAW a SOLID

[sergiu_ciuhnenco]

Need a prgram which must define the insertion point, and define the closed contour and insert a solid in the order of the points drawn on the drawing .
I sure this will help a lot of people !
Thanks in advance !!!

[tombu]

No code needed just follow the instructions for the SOLID Command. For it to work your 3rd point needs to be your 2nd point and your 2nd point needs to be your 3rd.

Think of your first two points as a base with the 3rd point as the corner that is opposite the 2nd point. The 4th point is diagonally opposite the first point.

 

You could also use a solid hatch.

[sergiu_ciuhnenco]

Of course it could be done manually, but I am searching for a easier way .
I have a lot of holes which I have to draw this symbol , it will help me a lot !!!
Your point order also is working 
1) red 
2) cyan
3) yellow
4) blue

[sergiu_ciuhnenco]

(setq p1 (list x-min y-min))
 (setq p2 (list x-min y-max))
 (setq p3 (list x-min +100 y-max -100))
 (setq p4 (list x-max y-max))
 (setq corners (list p1 p2 p3 p4)

[Tharwat]

Here you go.

NOTE: You can avoid the history of the command call via setting the system variable cmdecho to zero then rest it back to default which should be one .

(defun c:Riser (/ p1 p2 p3 p4)
  ;;----------------------------------------------------;;
  ;;	Author : Tharwat Al Choufi			;;
  ;; website: https://autolispprograms.wordpress.com	;;
  ;;----------------------------------------------------;;
  (and (setq p1 (getpoint "\n1st point : "))
       (setq p2 (getcorner "\n2nd point : " p1))
       (or (and (> (distance p1 (setq p3 (list (car p1) (cadr p2)))) 100)
                (> (distance p1 (setq p4 (list (car p2) (cadr p1)))) 100)
           )
           (alert
             "Width & Height of rectangle must exceed 100 to process. !"
           )
       )
       (command
         "_.-HATCH"
         "_P"
         "SOLID"
         "_s"
         (ssadd
           (entmakex
             (append
               '((0 . "LWPOLYLINE")
                 (100 . "AcDbEntity")
                 (100 . "AcDbPolyline")
                 (90 . 4)
                 (70 . 1)
                )
               (mapcar
                 (function (lambda (p) (cons 10 p)))
                 (list p1 p3 (polar p1 (angle p1 p2) (sqrt 20000.0)) p4)
               )
             )
           )
         )
         ""
         ""
       )
  )
  (princ)
)

 

[Ajmal]

i think your going to make for this duct  section, if am not wrong you can try this 

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

 

[sergiu_ciuhnenco]

Thanks " Ajmal ". 
Tharwat , your lisp in my case is better , thank you !!!!!

Edited July 13, 2023 by sergiu_ciuhnenco

[Tharwat]

You're welcome anytime.