Block insertion for Lisp

Block insertion for Lisp

smallƑish
Advocate Advocate
266 Views
2 Replies
Message 1 of 3

Block insertion for Lisp

smallƑish
Advocate
Advocate

I found this amazing lisp on the Internet. please, anyone, help me to modify it.

The Lisp working to draft the AC duct branch

How its works now ;

  • BBB (to activate)
  • Select B1, B2, B3.
  • It will generate the branch shoe amazingly.

I am looking for an update on it, Just INSERT a VDC block on it, Stretch it with reference to the branch width.

DWG is attached to get the concept.

 

 

(defun C:BBB (/ ang1 ang2 ent1 ent2 ent3 ep1 ep3 ipt1 ipt2 ipt21
    mp1 mp3 obj1 obj2 obj3 pt1 pt2 pt3 sp1 sp3)
(setq ent1 (entsel "\nSelect first line >>")
      ent2 (entsel "\nSelect second line >>")
      ent3 (entsel "\nSelect third line >>")
      obj1 (vlax-ename->vla-object (car ent1))
      obj2 (vlax-ename->vla-object (car ent2))
      obj3 (vlax-ename->vla-object (car ent3))
      )
(setq sp1  (vlax-curve-getstartpoint obj1)
      ep1  (vlax-curve-getendpoint obj1)
      mp1  (mapcar (function (lambda (a b) (/ (+ a b) 2))) sp1 ep1)
      sp3  (vlax-curve-getstartpoint obj3)
      ep3  (vlax-curve-getendpoint obj3)
      mp3  (mapcar (function (lambda (a b) (/ (+ a b) 2))) sp3 ep3)
      ipt1 (vlax-invoke obj1 'intersectwith obj3 0)
      ipt2 (vlax-invoke obj2 'intersectwith obj3 0)
      ang1 (angle ipt1 mp1)
      ang2 (angle ipt2 ipt1)
      pt1  (polar ipt1 ang1 100)
      pt2  (polar ipt2 ang1 100)
      pt3  (polar ipt1 ang2 100)
      )
     (command "_.break" ent1 "f" "_non" pt1 "_non" ipt1)
     (command "line" "_non" pt1 "_non" pt2 "")
     (command "line" "_non" pt1 "_non" pt3 "")
(princ)
)



(SETVAR "CMDECHO" 0)
(SETVAR "BLIPMODE" 0)
(SETQ OS (GETVAR "OSMODE"))
(SETVAR "OSMODE" 0)
(SETQ LAL (GETVAR "CLAYER")) 
(DEFUN C:TT() 
        (SETQ E1 (ENTSEL))
        (SETQ EN1 (ENTGET (CAR E1)))
        (SETQ E2 (ENTSEL))
        (SETQ E3 (ENTSEL))
        (SETQ EN3 (ENTGET (CAR E3)))
        (SETQ P13 (CDR (ASSOC 10 EN3)))
        (SETQ P23(CDR (ASSOC 11 EN3)))
        (SETQ P1 (CDR (ASSOC 10 EN1)))
        (SETQ P2 (CDR (ASSOC 11 EN1)))
        (COMMAND "OFFSET" "150" E3 P1 "")
        (SETQ E4 (ENTLAST))
        (SETQ P14 (CDR (ASSOC 10 (ENTGET E4))))
        (SETQ P24 (CDR (ASSOC 11 (ENTGET E4))))
        (COMMAND "EXTEND" E4 "" E1 E2 "")
        (COMMAND "TRIM" E1 E2 "" P14 P24 "")
        (COMMAND "EXTEND" E3 "" E2 "")
        (SETVAR "CHAMFERA" 150)
        (SETVAR "CHAMFERB" 150)
        (COMMAND "CHAMFER" E1 E3)
        (COMMAND "ERASE" E3 "")
        (COMMAND "LINE" P13 P23 "")
        )
(SETVAR "CMDECHO" 1)
(SETVAR "BLIPMODE" 0)
(SETVAR "OSMODE" OS)
(SETVAR "CLAYER" LAL)
(PRINC)

 

 

 

0 Likes
Accepted solutions (1)
267 Views
2 Replies
Replies (2)
Message 2 of 3

komondormrex
Mentor
Mentor
Accepted solution

check the correction to the original 'bbb' lisp.

(defun C:BBB (/ ang1 ang2 ent1 ent2 ent3 ep1 ep3 ipt1 ipt2 ipt21
    		    mp1 mp3 obj1 obj2 obj3 pt1 pt2 pt3 sp1 sp3)
	(setq ent1 (entsel "\nSelect first line >>")
	      ent2 (entsel "\nSelect second line >>")
	      ent3 (entsel "\nSelect third line >>")
	      obj1 (vlax-ename->vla-object (car ent1))
	      obj2 (vlax-ename->vla-object (car ent2))
	      obj3 (vlax-ename->vla-object (car ent3))
	      sp1  (vlax-curve-getstartpoint obj1)
	      ep1  (vlax-curve-getendpoint obj1)
	      mp1  (mapcar (function (lambda (a b) (/ (+ a b) 2))) sp1 ep1)
	      sp3  (vlax-curve-getstartpoint obj3)
	      ep3  (vlax-curve-getendpoint obj3)
	      mp3  (mapcar (function (lambda (a b) (/ (+ a b) 2))) sp3 ep3)
	      ipt1 (vlax-invoke obj1 'intersectwith obj3 0)
	      ipt2 (vlax-invoke obj2 'intersectwith obj3 0)
	      ang1 (angle ipt1 mp1)
	      ang2 (angle ipt2 ipt1)
	      pt1  (polar ipt1 ang1 100)
	      pt2  (polar ipt2 ang1 100)
	      pt3  (polar ipt1 ang2 100)
	)
	(command "_.break" ent1 "f" "_non" pt1 "_non" ipt1)
	(command "line" "_non" pt1 "_non" pt2 "")
	(command "line" "_non" pt1 "_non" pt3 "")
	(setq vcd_block (vla-insertblock (vla-get-block (vla-get-activelayout (vla-get-activedocument (vlax-get-acad-object))))
			  		 				 (vlax-3d-point (trans pt1 1 0))
		     	              	 	 "-ep-vcd"
		      	 	      	 		 1 1 1 (+ (* 0.5 pi) (angle (trans ipt1 1 0) (trans pt1 1 0))) 
		     		)
	      vcd_block_dynamic_properties (vlax-invoke vcd_block 'getdynamicblockproperties)
	)
	(vla-put-layer vcd_block "m-vcds") 
  	(if (/= (angle (trans pt1 1 0) (trans ipt1 1 0)) (- (+ (* 0.5 pi) (angle (trans ipt1 1 0) (trans pt1 1 0))) (* 0.5 pi)))
	  	(progn
		  	(vl-some '(lambda (property) (= "Flip state2" (vla-get-propertyname (setq target_property property)))) vcd_block_dynamic_properties) 
			(vla-put-value target_property (vlax-make-variant 1 vlax-vbinteger))
			(setq flipped_2 pi)
	  	)
		(setq flipped_2 0)
  	)
  	(if (/= (angtos (angle (trans pt1 1 0) (trans pt2 1 0))) (angtos (- (+ (* 0.5 pi) (angle (trans ipt1 1 0) (trans pt1 1 0))) flipped_2)))
	  	(progn
		  	(vl-some '(lambda (property) (= "Flip state1" (vla-get-propertyname (setq target_property property)))) vcd_block_dynamic_properties) 
			(vla-put-value target_property (vlax-make-variant 1 vlax-vbinteger)) 
	  	)
  	)
	(vl-some '(lambda (property) (= "Distance1" (vla-get-propertyname (setq target_property property)))) vcd_block_dynamic_properties) 
	(vla-put-value target_property (distance pt1 pt2)) 
	(princ)
)
0 Likes
Message 3 of 3

smallƑish
Advocate
Advocate

Thank you so much, Its works perfectly. again Thank you so much. its again a ton time saver 

0 Likes