• Add-On’s
  • Download
  • History of AutoLISP
  • Lisp Resources
  • Run an AutoLISP

LispBox

~ This blog was initially created for people, who love autolisp routines, as I love it.

Monthly Archives: July 2016

HVAC Andrea Andreetti TAPER TRANSITION

31 Sunday Jul 2016

Posted by danglar71 in HVAC, Lisp Collection 2014

≈ Leave a comment


;| ;;
TAPER TRANSITION - 2008-10-18 ;;
Par Andrea Andreetti ;;
|;
;;
(defun c:taper ()
(setq gdc2 (getreal "Grandeur de la conduite : "))
(setq gdc2demi (/ gdc2 2.0))
(setq l1 (nentsel "premiere ligne..."))
(setq l2 (nentsel "ligne Opposי..."))
(setq entl1 (entget (car l1)))
(setq entl2 (entget (car l2)))
(setq l1a (cdr (assoc 10 (entget (car l1)))))
(setq l1b (cdr (assoc 11 (entget (car l1)))))
(setq l2a (cdr (assoc 10 (entget (car l2)))))
(setq l2b (cdr (assoc 11 (entget (car l2)))))
(if (< (distance (cadr l1) l1a) (distance (cadr l1) l1b))
(progn (setq l1 l1a) (setq ductway (angle l1b l1a)))
(progn (setq l1 l1b) (setq ductway (angle l1a l1b)))
)
(setq l2 (polar l1 (+ (dtr 90) (angle l1a l1b)) 5))
(setq il1 (inters l1 l2 l1a l1b nil))
(setq il2 (inters l1 l2 l2a l2b nil))
(if (< (distance il2 (cdr (assoc 10 entl2)))
(distance il2 (cdr (assoc 11 entl2)))
)
(progn (setq toreplace (assoc 10 entl2))
(setq bythis (cons 10 il2))
)
(progn (setq toreplace (assoc 11 entl2))
(setq bythis (cons 11 il2))
)
)
(entmod (subst bythis toreplace entl2))
(setq lunit (getvar "lunits"))
(if (< lunit 3)
(setq 6po 150)
(setq 6po 3)
)
(setq gdc1 (distance il1 il2))
(if (< (abs (* 3.0 (- gdc1 gdc2))) 6po)
(setq len 6po)
(setq len (abs (* 3.0 (- gdc1 gdc2))))
)

(setq mid1 (polar il1 (angle il1 il2) (/ (distance il1 il2) 2.0)))
(setq mid2 (polar mid1 ductway len))
(setq midl2 (polar mid2 (angle il1 il2) gdc2demi))
(setq midl1 (polar mid2 (angle il2 il1) gdc2demi))
(setq fixmid2 mid2)
(setq midlist (list mid2 midl2 midl1))

(setq midl1 (polar il1 ductway len))
(setq midl2 (polar midl1 (angle il1 il2) gdc2))
(setq mid2 (polar midl1 (angle il1 il2) gdc2demi))
(setq fixmidl2 midl2)
(setq l1list (list mid2 midl2 midl1))

(setq midl2 (polar il2 ductway len))
(setq midl1 (polar midl2 (angle il2 il1) gdc2))
(setq mid2 (polar midl2 (angle il2 il1) gdc2demi))
(setq fixmidl1 midl1)
(setq l2list (list mid2 midl2 midl1))

(while (or (= (car (setq grr (grread t 5 0))) 5)
(= (car (setq grr (grread t 5 0))) 2)
)
(redraw)
(if (< (distance (cadr grr) fixmid2)
(distance (cadr grr) fixmidl2)
)
(setq goodlist midlist)
)
(if (< (distance (cadr grr) fixmidl2)
(distance (cadr grr) fixmid2)
)
(setq goodlist l2list)
)
(if (< (distance (cadr grr) fixmidl1)
(distance (cadr grr) fixmid2)
)
(setq goodlist l1list)
)
(grdraw (nth 1 goodlist) (nth 2 goodlist) 147 0)
(grdraw (nth 1 goodlist) il2 147 0)
(grdraw (nth 2 goodlist) il1 147 0)
(grdraw il1 il2 147 0)
(setq intp2t (polar (nth 0 goodlist)
ductway
(distance fixmid2 (cadr grr))
)
)
(setq intp2z (polar (cadr grr) (angle midl1 midl2) gdc2demi))
(setq p2 (inters (nth 0 goodlist) intp2t (cadr grr) intp2z nil))
(setq p21 (polar p2 (angle midl2 midl1) gdc2demi))
(setq p22 (polar p2 (angle midl1 midl2) gdc2demi))
(grdraw (nth 1 goodlist) p22 147 0)
(grdraw (nth 2 goodlist) p21 147 0)

(if S2RT
(progn
(grdraw il1 (nth 0 goodlist) 1 1)
(grdraw il2 (nth 0 goodlist) 1 1)
(setq Jonc1 (polar (nth 1 goodlist) ductway 6po))
(setq Jonc2 (polar (nth 2 goodlist) ductway 6po))
(grdraw jonc1 jonc2 8 1)
)
)

(if R2ST
(progn
(grdraw mid1 (nth 1 goodlist) 1 1)
(grdraw mid1 (nth 2 goodlist) 1 1)
(setq Jonc1 (polar il1 (+ (dtr 180) ductway) 6po))
(setq Jonc2 (polar il2 (+ (dtr 180) ductway) 6po))
(grdraw jonc1 jonc2 8 1)
)
)

)
(taperentmake (cons 10 (nth 1 goodlist))
(cons 11 (nth 2 goodlist))
nil
nil
)
(taperentmake (cons 10 il2)
(cons 11 (nth 1 goodlist))
nil
nil
)
(taperentmake (cons 10 il1)
(cons 11 (nth 2 goodlist))
nil
nil
)
(taperentmake (cons 10 il1) (cons 11 il2) nil nil)
(taperentmake (cons 10 (nth 1 goodlist))
(cons 11 p22)
nil
nil
)
(taperentmake (cons 10 (nth 2 goodlist))
(cons 11 p21)
nil
nil
)
(redraw)
)
;;
;| |;

;| ;;
Degre To Radian ;;
|;
;;
(defun dtr (a)
(* pi (/ a 180.0))
)
;;
;| |;

;| ;;
Square To Round TRANSITION ;;
|;
;;
(defun c:s2r (/ Jonc1 Jonc2 S2RT)
(setq S2RT T)
(c:taper)
(setq Jonc1 (polar (nth 1 goodlist) ductway 6po))
(setq Jonc2 (polar (nth 2 goodlist) ductway 6po))
(Jonction_create Jonc1 Jonc2)

(taperentmake (cons 10 il1)
(cons 11 (nth 0 goodlist))
1
nil
)
(taperentmake (cons 10 il2)
(cons 11 (nth 0 goodlist))
1
nil
)
)
;;
;| |;

;| ;;
Round To Square TRANSITION ;;
|;
;;
(defun c:r2s (/ jonc1 jonc2 R2ST)
(setq R2ST T)
(c:taper)
(setq Jonc1 (polar il1 (+ (dtr 180) ductway) 6po))
(setq Jonc2 (polar il2 (+ (dtr 180) ductway) 6po))
(Jonction_create Jonc1 Jonc2)

(taperentmake (cons 10 mid1)
(cons 11 (nth 1 goodlist))
1
nil
)
(taperentmake (cons 10 mid1)
(cons 11 (nth 2 goodlist))
1
nil
)
)
;;
;| |;

;| ;;
ENTMAKE FUNCTION ;;
|;
;;
(defun jonction_create (J1 J2)
;; Assuming that ACAD.LIN Exist and contain "ACAD_ISO03W100" Linetype
(if (not (member "ACAD_ISO03W100" (mapcar 'strcase (ai_table "LTYPE" 0))))
(if (findfile "acad.lin")
(vl-cmdf "._-linetype" "_L" "ACAD_ISO03W100" "" "")
))

(taperentmake (cons 10 J1)
(cons 11 J2)
8
"ACAD_ISO03W100"
)
)
;;
;| |;

;| ;;
ENTMAKE FUNCTION ;;
|;
;;
(defun taperentmake (start end color linetype / lllist)
(setq lllist (list '(0 . "LINE") start end))
(if color
(setq lllist (append lllist (list (cons 62 color))))
)
(if linetype
(setq lllist (append lllist (list (cons 6 linetype))))
)
(entmake lllist)
)
;;
;| |;

HVAC Andrea Andreetti D U C T C O N N E C T

31 Sunday Jul 2016

Posted by danglar71 in HVAC, Lisp Collection 2014

≈ Leave a comment


;;By Andrea Andreetti 2008-11-24 ;;
;; ;;
;; D U C T C O N N E C T ;;
;; ;;
;;

(defun c:DuctConnect (/ dr_sel1 dr_sel1data p1 SDrain_10 SDrain_11 DuctStyle1)

;; Degre to Radian ;;
;;
(defun dtr (a)
(* pi (/ a 180.0))
)
;;
;; Degre to Radian ;;

;; Language Detection ;;
;;
(if (vl-string-search "(FR)" (strcase (ver)))
(progn
(setq qstion0 "\nCommande: DuctConnect -Activי")
(setq qstion1 "Type de Conduit (C)arrי/(R)ond <")
(setq qstion2 "Largeur du conduit: ")
(setq qstion3 "Sיlection de la ligne du conduit: ")
)
(progn
(setq qstion0 "\nCommand: DuctConnect -Activated")
(setq qstion1 "Duct Type (S)quare/(R)ound : ")))
(if DuctStyle1 (Setq DuctStyle DuctStyle1))
;;
;; DuctStyle Detection ;;

;; Selection and Data operation ;;
;;
(setq LarDC (getreal qstion2))
(setq LarDC2 (/ LarDC 2))
(setq dr_sel1 nil)
(while (or (= dr_sel1 nil)
(/= (cdr (assoc 0 (setq dr_sel1data (entget (car dr_sel1))))) "LINE"))
(progn
(princ qstion3)
(setq dr_sel1 (entsel))
)
)
(setq p1 (osnap (cadr dr_sel1) "_near"))
(setq SDrain_10 (cdr (assoc 10 dr_sel1data))) ;Start Point
(setq SDrain_11 (cdr (assoc 11 dr_sel1data))) ;End Point
(setq SDrain_8 (cdr (assoc 8 dr_sel1data))) ;Layer
(setq SDrain_62 (cdr (assoc 62 dr_sel1data))) ;Color
(setq SDrain_6 (cdr (assoc 6 dr_sel1data))) ;Linetype

;;
;; Selection and Data operation ;;

;; Units detection for ZY and ZY2 variables ;;
;;
(if (< (getvar "LUNITS") 3)
(setq zy 100)
(setq zy 4)
)
(setq zy2 (/ zy 2))
;;
;; Units detection for ZY and ZY2 variables ;;

;; PREVIEW MODE ;;
;;
(simulductattach)
;;
;; PREVIEW MODE ;;

)
;;
;; ;;
;; D U C T C O N N E C T ;;
;; ;;

;; ;;
;; S I M U L D U C T A T T A C H ;;
;; ;;
;;
(defun simulductattach (/ #elp agp1 pstart1 pstart2 pointtomod ndrainent)

(while (= (car (setq grr (grread t 2))) 5)
(redraw)
(grdraw p1 (polar p1 (dtr 0) zy2) 52 1)
(grdraw p1 (polar p1 (dtr 45) zy2) 52 1)
(grdraw p1 (polar p1 (dtr 90) zy2) 52 1)
(grdraw p1 (polar p1 (dtr 135) zy2) 52 1)
(grdraw p1 (polar p1 (dtr 180) zy2) 52 1)
(grdraw p1 (polar p1 (dtr 225) zy2) 52 1)
(grdraw p1 (polar p1 (dtr 270) zy2) 52 1)
(grdraw p1 (polar p1 (dtr 315) zy2) 52 1)
(setq #elp (car (cdr grr)))
(setq agp1 (inters #elp
(polar #elp (+ (angle sdrain_11 sdrain_10) (dtr 90)) 2.0)
sdrain_10
sdrain_11
nil
)
)
(if (not agp1)
(setq agp1 (inters #elp
(polar #elp (+ (angle sdrain_10 sdrain_11) (dtr 90)) 2.0)
sdrain_10
sdrain_11
nil
)
)
)
(setq Djp1 (polar agp1 (angle agp1 p1) (+ LarDC2 zy)))
(setq Djpx (polar Djp1 (angle Djp1 agp1) zy))
(setq DjpA (polar Djpx (angle agp1 #elp) zy))
(setq DLp1 (polar Djpx (angle agp1 #elp) (distance agp1 #elp)))

(setq Djp2 (polar agp1 (angle p1 agp1) LarDC2))
(setq DLp2 (polar Djp2 (angle agp1 #elp) (distance agp1 #elp)))
(setq Djpb (polar Djp2 (angle agp1 #elp) zy))

(grdraw djp1 djpa 141 1)
(grdraw djpa dlp1 141 1)
(grdraw djpa djpb 141 1)
(grdraw djp2 dlp2 141 1)

(if (eq DuctStyle "R")
(progn
(setq djpm (polar djpa (angle djpa djpb) (/ (distance djpa djpb) 2)))
(setq djrja (polar djpa (angle agp1 #elp) (* zy 0.75)))
(setq djrjb (polar djpb (angle agp1 #elp) (* zy 0.75)))
(grdraw djp1 djpm 1 1)
(grdraw djp2 djpm 1 1)
(grdraw djrja djrjb 33 1)
)
)
)

(if (eq (car grr) 3)
(progn
(if (eq DuctStyle "R")
(if (and djp1 djpa dlp1 djp2 dlp2 djpa djpb djrja djrjb)
(progn
(Duct_entmake djp1 djpa SDrain_6 SDrain_62 SDrain_8)
(Duct_entmake djpa dlp1 SDrain_6 SDrain_62 SDrain_8)
(Duct_entmake djp2 dlp2 SDrain_6 SDrain_62 SDrain_8)
(Duct_entmake djpa djpb SDrain_6 SDrain_62 SDrain_8)
(Duct_entmake djp1 djpm "continuous" 1 SDrain_8)
(Duct_entmake djp2 djpm "continuous" 1 SDrain_8)

;;Assume that ACAD.LIN exist and contain the ACAD_ISO03W100 Linetype.
(if (not (member "ACAD_ISO03W100" (mapcar 'strcase (ai_table "LTYPE" 0))))
(vl-cmdf "._linetype" "_L" "ACAD_ISO03W100" "acad.lin"))
(Duct_entmake djrja djrjb "ACAD_ISO03W100" 33 SDrain_8)
;;------------------------------------------------------------------;;

(redraw)
)
)

(if (and djp1 djpa dlp1 djp2 dlp2 djpa djpb)
(progn
(Duct_entmake djp1 djpa SDrain_6 SDrain_62 SDrain_8)
(Duct_entmake djpa dlp1 SDrain_6 SDrain_62 SDrain_8)
(Duct_entmake djp2 dlp2 SDrain_6 SDrain_62 SDrain_8)
(Duct_entmake djpa djpb SDrain_6 SDrain_62 SDrain_8)
(redraw)
)
)
)

(redraw)
(simulductattach)
)
(progn (redraw) (exit)(princ))
)
)
;;
;; ;;
;; S I M U L D U C T A T T A C H ;;
;; ;;

;; ;;
;; D U C T _ E N T M A K E ;;
;; ;;
;;
(defun Duct_entmake (#10p #11p ForceLinetype ForceColor ForceLayer / ety_data)
(setq ety_data
(list
'(0 . "LINE") ; Object type
(cons 10 #10p) ; Start Point
(cons 11 #11p) ; End Point
(cons 8 SDrain_8) ; Layer
)
)

(if ForceLinetype
(setq ety_data (append ety_data (list (cons 6 ForceLinetype))))
)

(if ForceColor
(setq ety_data (append ety_data (list (cons 62 ForceColor))))
(if (and DuctColor (/= DuctColor 256))
(setq ety_data (append ety_data (list (cons 62 DuctColor))))
)
)
(entmake ety_data)
)
;;
;; ;;
;; D U C T _ E N T M A K E ;;
;; ;;

;;======================================;;
;; AUTO-LOAD ;;
;;======================================;;
(princ
qstion0)

HVAC Andrea Andreetti D U C T A T T A C H

31 Sunday Jul 2016

Posted by danglar71 in HVAC, Lisp Collection 2014

≈ Leave a comment

;;By Andrea Andreetti 2008-11-27 ;;
;; ;;
;; D U C T A T T A C H ;;
;; ;;
;;

(defun c:DuctAttach (/ Ent_10 Ent_11 Ent_62 Ent_0 Inter_L1 Inter_L2 entData Basepoint1 Basepoint2
Dduct grjp1 grjp2 ficp1 ficp2 ficpX #DCswitch Dway1 Dway2 Dway3 Dway4 ArcEnt
dr_sel1 dr_sel2 SLi_0 VLA_line1 VLA_line1_start VLA_line1_end ArcEntLIST
VLA_line2 VLA_line2_start VLA_line2_end 4po GEN_clayercolor Input entData arcX arcY
newLine 1_sp 1_sp 3_sp 4_sp)

(setq ArcEnt nil)

;; Degre Conversion ;;
;;
(defun dtr (a)
(* pi (/ a 180.0))
)

(defun rtd (a)
(/ (* a 180) pi)
)
;;
;; Degre Conversion ;;

(DCclean)
(if (not #DCswitch)(setq #DCswitch 0))
(setq dr_sel1 nil
dr_sel2 nil)

(while (or (= dr_sel1 nil)
(/= (cdr (assoc 0 (setq dr_sel1data (entget (car dr_sel1))))) "LINE")
)
(setq dr_sel1 (entsel "\nSlection des lignes du conduit..."))
)

(while (or (= dr_sel2 nil)
(/= (cdr (assoc 0 (setq dr_sel2data (entget (car dr_sel2))))) "LINE")
)
(setq dr_sel2 (entsel "\nSlection des lignes du conduit..."))
)

(if (and dr_sel1 dr_sel2)
(progn
(setq SLi_0 (cdr (assoc 8 (entget (car dr_sel1)))))
(setq VLA_line1 (vlax-ename->vla-object (car dr_sel1)))
(setq VLA_line1_start (vlax-get VLA_line1 'startpoint))
(setq VLA_line1_end (vlax-get VLA_line1 'endpoint))

(setq VLA_line2 (vlax-ename->vla-object (car dr_sel2)))
(setq VLA_line2_start (vlax-get VLA_line2 'startpoint))
(setq VLA_line2_end (vlax-get VLA_line2 'endpoint))

(if ( #DCswitch 5)
(setq #DCswitch 0)
(setq #DCswitch (1+ #DCswitch))
)

(progn
(if (eq #DCswitch 0) (princ "\n- Switched to Square/Square excentric connection -"))
(if (eq #DCswitch 1) (princ "\n- Switched to Square/Square Straight connection -"))
(if (eq #DCswitch 2) (princ "\n- Switched to Square/Square Concentric connection -"))
(if (eq #DCswitch 3) (princ "\n- Switched to Round/Square Concentric connection -"))
(if (eq #DCswitch 4) (princ "\n- Switched to Round/Round Concentric connection -"))
(if (eq #DCswitch 4) (princ "\n- Switched to Round/Round Straight connection -"))

)
)
)
(DCswitch)
;;
;;SWITCH MODE ;;

)
)
)
(DCclean)

(if (eq (car Input) 3)
(Ductattach_exe)
)

)
;;
;; ;;
;; D U C T A T T A C H ;;
;; ;;

;; ;;
;; D C S W I T C H ;;
;; ;;
;;
(defun DCswitch (/ )

(if (and (setq EntName (car (nentselp (setq cursorLocation (cadr Input)))))
(not (eq Iname EntName))
)
(progn
(DCclean)
(setq entData (entget EntName))
(setq Ent_0 (cdr (assoc 0 entData)))
(if (setq Ent_62 (assoc 62 entData))
(setq Ent_62 (cdr Ent_62))
(setq Ent_62 GEN_clayercolor)
)
(setq Ent_10 (cdr (assoc 10 entData)))
(setq Ent_11 (cdr (assoc 11 entData)))

(if (eq Ent_0 "LINE")
(progn
(setq VLA_line0 (vlax-ename->vla-object (cdr (car entData))))

(setq Inter_L1 (vlax-invoke VLA_line0 'intersectwith VLA_line1 acExtendBoth))
(setq Inter_L2 (vlax-invoke VLA_line0 'intersectwith VLA_line2 acExtendBoth))
(if (and Inter_L1 Inter_L2)
(progn
(if (<
(distance Inter_L1 VLA_line1_start)
(distance Inter_L1 VLA_line1_end)
)
(setq Basepoint1 VLA_line1_end)
(setq Basepoint1 VLA_line1_start)
)
(if ( (distance grjp1 Inter_L2)(distance grjp2 Inter_L1))
(progn

(setq ficp1 (polar grjp1 (+ (angle inter_L1 grjp1) (dtr 90)) 4po))
(setq ficp2 (polar grjp1 (- (angle inter_L1 grjp1) (dtr 90)) 4po))
(if (< (distance ficp1 grjp2)(distance ficp2 grjp2))
(setq ficpx ficp1)
(setq ficpx ficp2)
)
(setq grjp2 (inters grjp1 ficpx inter_L2 basepoint2 nil))

)

(progn
(setq ficp1 (polar grjp2 (+ (angle inter_L2 grjp2) (dtr 90)) 4po))
(setq ficp2 (polar grjp2 (- (angle inter_L2 grjp2) (dtr 90)) 4po))
(if (< (distance ficp1 grjp1)(distance ficp2 grjp1))
(setq ficpx ficp1)
(setq ficpx ficp2)
)
(setq grjp1 (inters grjp2 ficpx inter_L1 basepoint1 nil))

)
)
)

;;joint Line
(grdraw Basepoint1 grjp1 Ent_62 1)
(grdraw Basepoint2 grjp2 Ent_62 1)
(grdraw grjp1 grjp2 Ent_62 1)

;;Square/Square excentric connection ;;
;;
(if (= #DCswitch 0)
(progn
(if (and (/= #DCswitchOLD #DCswitch)
ArcEnt)
(progn (entdel ArcEnt)(setq ArcEnt nil))
)
(if ( (distance cenOFarc Dway1)(distance midjoint Dway1))
(setq cenOFarc (polar midjoint (- (angle Dway2 Dway4) (dtr 90)) 4po))
)

(setq arcX (polar midjoint (- (angle cenOFarc midjoint) (dtr 90)) (distance midjoint Dway2)))
(setq arcY (polar midjoint (+ (angle cenOFarc midjoint) (dtr 90)) (distance midjoint Dway2)))
(setq ArcEntLIST
(list
'(0 . "ARC");;Type
(cons 8 SLi_0);;Layer
'(100 . "AcDbCircle");;Catיgorie
(cons 10 cenOFarc);;Center Point
(cons 40 (distance cenOFarc Dway2));;Radius
'(100 . "AcDbArc")
(cons 50 (angle cenOFarc arcX));;Dway2))
(cons 51 (angle cenOFarc arcY));;Dway4))
(cons 62 Ent_62)
)
)

(setq ArcEnt (entmakex ArcEntLIST))
(setq #DCswitchOLD #DCswitch)
)
)
;;
;;Switched to Round/Round Concentric connection ;;

;;Switched to Round/Round Straight connection ;;
;;
(if (= #DCswitch 5)
(progn
(if (and (/= #DCswitchOLD #DCswitch)
ArcEnt)
(progn (entdel ArcEnt)(setq ArcEnt nil))
)
(setq Dway1 grjp1
Dway2 Inter_L1
Dway3 grjp2
Dway4 Inter_L2
)
(setq Rj1 (polar Dway1 (angle Inter_L1 Basepoint1) (* 4po 0.75)))
(setq Rj2 (polar Dway3 (angle Inter_L2 Basepoint2) (* 4po 0.75)))
(grdraw Rj1 Rj2 33 1)

;;Draw ARC
(setq midjoint (polar Dway2 (angle Dway2 Dway4) (/ (distance Dway2 Dway4) 2)))
(setq cenOFarc (polar midjoint (+ (angle Dway2 Dway4) (dtr 90)) 4po))
(if (> (distance cenOFarc Dway1)(distance midjoint Dway1))
(setq cenOFarc (polar midjoint (- (angle Dway2 Dway4) (dtr 90)) 4po))
)

(setq arcX (polar midjoint (- (angle cenOFarc midjoint) (dtr 90)) (distance midjoint Dway2)))
(setq arcY (polar midjoint (+ (angle cenOFarc midjoint) (dtr 90)) (distance midjoint Dway2)))

(setq ArcEntLIST
(list
'(0 . "ARC");;Type
(cons 8 SLi_0);;Layer
'(100 . "AcDbCircle");;Catיgorie
(cons 10 cenOFarc);;Center Point
(cons 40 (distance cenOFarc Dway2));;Radius
'(100 . "AcDbArc")
(cons 50 (angle cenOFarc arcX))
(cons 51 (angle cenOFarc arcY))
(cons 62 Ent_62)
)
)
(setq ArcEnt (entmakex ArcEntLIST))
(setq #DCswitchOLD #DCswitch)
)
)
;;
;;Switched to Round/Round Straight connection ;;

;;GRDRAW Connection
(grdraw Dway1 Dway2 Ent_62 1)
(grdraw Dway3 Dway4 Ent_62 1)

)
)
)
)
(if (= (car Input) 11)(DCclean))
)
)
)

;;
;; ;;
;; D C S W I T C H ;;
;; ;;

;; ;;
;; DUCTATTACH_EXE ;;
;; ;;
;;

(defun Ductattach_exe ()

(if (and Dway1 Dway2 Dway3 Dway4)
(progn

(setq actdoc (vla-get-activedocument (vlax-get-acad-object)))
(setq space (if (= (getvar "cvport") 1)
(vla-get-paperspace actdoc)
(vla-get-modelspace actdoc)
)
)

(vla-put-StartPoint VLA_line1 (vlax-3d-point basepoint1))
(vla-put-EndPoint VLA_line1 (vlax-3d-point grjp1))

(vla-put-StartPoint VLA_line2 (vlax-3d-point basepoint2))
(vla-put-EndPoint VLA_line2 (vlax-3d-point grjp2))

(setq newLine (vlax-invoke space 'addline Dway1 Dway3))
(NLINE_chprop newline VLA_line1)

(setq newLine (vlax-invoke space 'addline Dway3 Dway4))
(NLINE_chprop newline VLA_line1)

(setq newLine (vlax-invoke space 'addline Dway1 Dway2))
(NLINE_chprop newline VLA_line1)

;; Round Duct Joint connection
(if (> #DCswitch 2)
(progn
(setq newLine (vlax-invoke space 'addline Rj1 Rj2))
;;Layer
(setq N_layer (vla-get-layer VLA_line1))
(vla-put-layer newLine N_layer)
;;Color
(vla-put-color newLine "33")

;;Linetype
;;Assume that ACAD.LIN exist and contain the ACAD_ISO03W100 Linetype.
(if (not (member "ACAD_ISO03W100" (mapcar 'strcase (ai_table "LTYPE" 0))))
(vl-cmdf "._linetype" "_L" "ACAD_ISO03W100" "acad.lin" ""))
(vla-put-linetype newline "ACAD_ISO03W100")

);_progn
);_if

;; Round Duct to Round Duct ARC design
(if (> #DCswitch 3)
(progn
(if ArcEntLIST (entmakex ArcEntLIST))
(setq newarc (vlax-ename->vla-object (entlast)))
(NLINE_chprop newarc VLA_line1)

(setq 1_sp (vlax-get VLA_line0 'startpoint))
(setq 4_sp (vlax-get VLA_line0 'endpoint))

(if (> (distance 1_sp Dway2)(distance 1_sp Dway4))
(progn
(setq 2_sp Dway4)
(setq 3_sp Dway2)
)
(progn
(setq 3_sp Dway4)
(setq 2_sp Dway2)
)
)
(vla-put-StartPoint VLA_line0 (vlax-3d-point 1_sp))
(vla-put-Endpoint VLA_line0 (vlax-3d-point 2_sp))
(setq newLine (vlax-invoke space 'addline 3_sp 4_sp))
(NLINE_chprop newline VLA_line0)
)
)
);_progn
)
)
;;
;; ;;
;; DUCTATTACH_EXE ;;
;; ;;

;; ;;
;; NLINE_chprop ;;
;; ;;
;;
(defun NLINE_chprop (Nline Sline)

;;Linetype
(setq N_linetype (vla-get-linetype Sline))
(vla-put-linetype NLine N_linetype)
;;Layer
(setq N_layer (vla-get-layer Sline))
(vla-put-layer NLine N_layer)
;;Color
(setq N_color (vla-get-Color Sline))
(vla-put-color NLine N_color)
;;Thickness
(setq N_thickness (vla-get-Thickness Sline))
(vla-put-Thickness NLine N_thickness)
)
;;
;; ;;
;; NLINE_chprop ;;
;; ;;

;; ;;
;; DCclean ;;
;; ;;
;;
(defun DCclean ()
(if ArcEnt (progn (entdel ArcEnt)(setq ArcEnt nil)))
(redraw)
)
;;
;; ;;
;; DCclean ;;
;; ;;

HVAC Draw Branch Duct

31 Sunday Jul 2016

Posted by danglar71 in HVAC, Lisp Collection 2014

≈ 1 Comment


(defun C:BD(/ 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 branch line >>")
ent2 (entsel "\nSelect second branch line >>")
ent3 (entsel "\nSelect main duct connection 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)
wid (getdist "\nEnter reduction distance...\n ")
pt1 (polar ipt1 ang1 wid)
pt2 (polar ipt2 ang1 wid)
pt3 (polar ipt1 ang2 wid)
)
(command "_.break" ent1 "f" "_non" pt1 "_non" ipt1)
(command "line" "_non" pt1 "_non" pt2 "")
(command "line" "_non" pt1 "_non" pt3 "")
(princ)
)
(c:bd)

HVAC Rectangular Duct Break Draw

31 Sunday Jul 2016

Posted by danglar71 in HVAC, Lisp Collection 2014

≈ Leave a comment

(defun tan (xx)
(/ (sin xx) (cos xx))
)

(defun c:db (/ a b d1 d2 u1 u2 u3 p1 p2)

(setq oerr *error*)
(defun *error* (msg)
(setvar "osmode" osn)
(setq *error* oerr)
(command)
(princ)
)

(setq osn (getvar "osmode"))
(setvar "osmode" 512)
(setq a (getpoint "\n Point on the duct: "))
(setvar "osmode" 128)
(setq b (getpoint a "\n Point on opposite wall of duct: "))
(setq d1 (distance a b))
(setvar "osmode" 512)
(setq u1 (angle a b))
(setq u2 (+ u1 (* pi 0.5)))
(setq u3 (+ u2 (/ pi 3)))
(setq p1 (polar b u2 (* d1 (tan (/ pi 6)))))
(setq d2 (/ (distance a p1) 2))
(setq p2 (polar b u3 d2))
(setvar "osmode" 0)
(command "_.line" a p1 "")
(command "_.line" b p2 "")
(setvar "osmode" osn)
(princ)
)

(prompt "\n Type > db < to draw HVAC duct break: ")
(c:db)

HVAC Duct Draw

31 Sunday Jul 2016

Posted by danglar71 in HVAC, Lisp Collection 2014

≈ Leave a comment


(defun rtd (a)
(/ (* a 180.0) pi)
)

(defun c:dct(/ eao)
(setvar "blipmode" 0)
(if (not cwidth)
(setq cwidth 0.0)
)
(MENUCMD "S=DUCT1")
(prompt (strcat "\n Enter duct width : "))
(setq tcwidth (getreal))
(if tcwidth
(setq cwidth tcwidth)
)
(MENUCMD "S=S")
(setq pt1 (getpoint "\nStart point... "))
(if pt1
(setq pt2 (getpoint pt1 "\nTo point... "))
)
(setq threshold 1
segment 0
oang nil
ofrad (getvar "filletrad")
)
(if (>= cwidth threshold)
(setq inrad (* 1.0 cwidth) outrad (* 2.0 cwidth))
)
(while pt2
(setq a (angle pt1 pt2)
1o1 (polar pt1 (+ a (/ pi 2.0)) (/ cwidth 2.0))
1o2 (polar pt2 (+ a (/ pi 2.0)) (/ cwidth 2.0))
ro1 (polar pt1 (- a (/ pi 2.0)) (/ cwidth 2.0))
ro2 (polar pt2 (- a (/ pi 2.0)) (/ cwidth 2.0))
)
(if (> segment 0)
(setq eao ea ebo eb)
(setq dimpt (polar pt1 (+ a (/ pi 2.0))(+ (/ cwidth 2.0) 1.0)))
)
(command "line" 1o1 1o2 "")
(setq ea (entlast))
(command "line" ro1 ro2 "")
(setq eb (entlast))
(if (and (> segment 0)(/= a oang)(/= pi (abs (- a oang))))
(progn
(setq xa (- oang a))
(if (or ( xa 0)( segment 0)
(setq po1 (cdr (assoc 11 (entget eao))))
)
(setq ss (ssadd eb))
(setq ss (ssadd ebo ss))
(setvar "filletrad" rb)
(command "fillet" (ssname ss 0)(ssname ss 1))
)
)
(setq pp2 (cdr (assoc 10 (entget eb))))
(if (> segment 0)
(setq po2 (cdr (assoc 11 (entget ebo))))
)
(if (and (> segment 0)(/= a oang))
(command "line" pp1 pp2 "")
(command "line" 1o1 ro1 "")
)
(if (and (> segment 0)(/= a oang))
(command "line" po1 po2 "")
)
(setq res "C")
(menucmd "S=duct2")
(setq res (getstring "Continue, Split, Double-Split, Transition : "))
(menucmd "S=S")
(cond
((or (= res "t")(= res "T")) (transition))
((or (= res "s")(= res "S")) (splitter))
((or (= res "d")(= res "D")) (splitter2))
(t (carryon))
)
) ;; END WHILE

(setq op1 (cdr (assoc 11 (entget ea))))
(setq op2 (cdr (assoc 11 (entget eb))))
(if (/= a oang)
(command "line" op1 op2 "")
(command "line" 1o2 ro2 "")
)
(setvar "filletrad" ofrad)
(setvar "cmdecho" 1)
(setvar "blipmode" 0)
(prin1)
)

(defun transition ()
(menucmd "S=DUCT1")
(setq newsize (getreal "\nEnter new size: "))
(menucmd "S=S")
(setq tlen (abs (* 3.732 (- cwidth newsize))))
(setq apt (getpoint pt2 "\nSide to remain straight"))
(setq rt-a (angle pt2 apt))
(setq s-rt (rtd (- a (/ pi 2.0))))
(if (< s-rt 0.0)
(setq s-rt (+ 360.0 s-rt))
)
; make sure all angles are positive ie -90 deg = 270 deg
(if (= (rtd rt-a) s-rt)
(setq dir "R")
(if (= rt-a a)
(setq dir "S")
(setq dir "L")
)
)
(if (= dir "L")
(setq newang (- a (/ pi 2.0)) spt 1o2)
(if (= dir "R")
(setq newang (+ a (/ pi 2.0)) spt ro2)
(setq newang a spt 1o2)
)
)
(if (or (= dir "R")(= dir "L"))
(progn
(setq l1p (polar spt a tlen))
(setq pt1 (polar l1p newang (/ newsize 2.0)))
(setq r1p (polar l1p newang newsize ))
(if (= dir "L")
(command "line" 1o2 ro2 r1p l1p "c")
(command "line" 1o2 ro2 l1p r1p "c")
)
) ; end progn
(progn
(setq tlen (/ tlen 2.0))
(setq p1 (polar pt2 a tlen))
(setq p2 (polar p1 (+ a (/ pi 2.0)) (/ newsize 2.0)))
(setq p3 (polar p2 (- a (/ pi 2.0)) newsize))
(command "line" p2 p3 ro2 1o2 p2 "")
(setq pt1 p1)
)
)
(setq pt2 (getpoint pt1 "\nTo point..."))
(if pt2
(progn
(while (< (+ (distance pt1 pt2) (/ cwidth 2.0)) outrad)
(setq pt2 (getpoint pt1 "\nTo point..."))
)
(setq segment (1+ segment))
(setq tcwidth newsize cwidth newsize oang a)
(setq inrad (* 1.0 cwidth) outrad (* 2.0 cwidth))
) ;; END PROGN
) ;; END IF
)

(defun carryon ()
;; BEGINNING FOR NORMAL CONTINUE OF DUCTING
(progn
(setq oang a
pt1 pt2
pt2 (getpoint pt1 "\nTo point..."))
(if pt2
(progn
(while (< (+ (distance pt1 pt2) (/ cwidth 2.0)) outrad)
(setq pt2 (getpoint pt1 "\nTo point..."))
)
(setq segment (1+ segment))
) ;; END PROGN
) ;; END IF
) ;; END OF PROGN FOR CONTINUE OPTION
)

;; branching ductwork
(defun splitter ()
(setq orth (getvar "ORTHOMODE"))
(setvar "ORTHOMODE" 1)
(setq apt (getpoint pt2 "\nDirection of Branch"))
(setq rt-a (angle pt2 apt))
(setq s-rt (rtd (- a (/ pi 2.0))))
(if (< s-rt 0.0)
(setq s-rt (+ 360.0 s-rt))
)
; make sure all angles are positive ie -90 deg = 270 deg
(if (= (rtd rt-a) s-rt)
(setq s-dir "R")
(setq s-dir "L")
)
(setvar "ORTHOMODE" orth)
(menucmd "S=duct1")

(setq s-dw1 (getreal "\nWidth of Branch Duct: "))
(setq s-dw2 (1+ cwidth))
; the main duct cannot increase here
(while (< cwidth s-dw2)
(setq s-dw2 (getreal "\nWidth of Continuing Main Duct: "))
)
(menucmd "S=S")
(setq c-side (* 2.0 s-dw1))
(if (= s-dir "R")
(setq s-1o2 1o2 s-ro2 ro2 arc-ang -90.0)
(setq s-1o2 ro2 s-ro2 1o2 arc-ang 90.0)
)
(setq s-p1 (polar s-1o2 a c-side))
(setq s-p2 (polar s-1o2 rt-a s-dw2))
(setq s-p3 (polar s-p2 a c-side))
(setq s-p4 (polar s-ro2 rt-a s-dw1))
(setq s-p5 (polar s-p4 a s-dw1))
(setq s-p6 (polar s-p5 a s-dw1))
(command "arc" s-ro2 "c" s-p4 "a" arc-ang)
(command "line" s-p5 s-p6 "")
(setq b-side (+ s-dw1 (- cwidth s-dw2)))
(setq a-side (sqrt (- (* c-side c-side)(* b-side b-side))))
(setq intpt (polar s-p2 a a-side))
(if (= s-dir "R")
(command "arc" s-p6 "c" s-p4 intpt)
(command "arc" intpt "c" s-p4 s-p6)
)
(command "line" intpt s-p3 s-p1 s-1o2 s-Ro2 "")
(setq 1o2 s-p1
ro2 s-p3
1o1 s-1o2
ro1 s-p2
pt1 (polar s-p1 rt-a (/ s-dw2 2.0))
cwidth s-dw2)
(setq pt2 (getpoint pt1 "\nTo point..."))
(setq tcwidth s-dw2 cwidth s-dw2 oang a)
(setq inrad (* 1.0 cwidth) outrad (* 2.0 cwidth))
)

(defun splitter2 ()
(setq s-rt (- a (/ pi 2.0)))
(setq s-rt2 (+ a (/ pi 2.0)))
(menucmd "S=duct1")
(setq s-dw1 (getreal "\nWidth of Left Branch Duct: "))
(setq s-dw2 (getreal "\nWidth of Right Branch Duct: "))
(setq rad1 (* 2.0 s-dw1))
(setq rad2 (* 2.0 s-dw2))
(setq c (+ s-dw1 s-dw2 cwidth))
(setq cosA (/ (- (+ (* RAD1 RAD1) (* c c))(* RAD2 RAD2)) (* 2.0 RAD1 c)))
(setq xlen (* cosA rad1))
(setq p1 (polar 1o2 s-rt2 s-dw1))
(setq p2 (polar p1 a s-dw1))
(setq p3 (polar p2 a s-dw1))
(setq xpt (polar p1 s-rt xlen))
(setq ylen (sqrt (- (* rad1 rad1)(* xlen xlen))))
(setq intpt (polar xpt a ylen))
(command "arc" intpt "c" p1 p3)
(command "arc" 1o2 "c" p1 p2)
(command "line" p2 p3 "")
(setq p1 (polar ro2 s-rt s-dw2))
(setq p2 (polar p1 a s-dw2))
(setq p3 (polar p2 a s-dw2))
(command "arc" p3 "c" p1 intpt)
(command "arc" p2 "c" p1 ro2)
(command "line" p2 p3 "")
(command "line" 1o2 ro2 "")
(setq 1o2 p2
ro2 p3
1o1 p2
ro1 p3
pt1 (polar p2 a (/ s-dw2 2.0))
cwidth s-dw2)
(setq pt2 (getpoint pt1 "\nTo point..."))
(setq tcwidth s-dw2 cwidth s-dw2 oang (- a (/ pi 2.0)))
(setq inrad (* 1.0 cwidth) outrad (* 2.0 cwidth))
)
(c:dct)

HVAC Diffuser Draw

31 Sunday Jul 2016

Posted by danglar71 in HVAC, Lisp Collection 2014

≈ Leave a comment

(defun c:dif (/ usrcmd size_h size_w p1 bang bdiag layer_setup)

(defun layer_setup (lyr Clr ltype)
(if (tblsearch "LAYER" lyr)
(command "._Layer" "_Thaw" lyr "_On" lyr "_UnLock" lyr "_Set" lyr "")
(command "._Layer" "_Make" lyr "_Color" (if (= Clr "") "_White" Clr) lyr
"LT" (if (= ltype "") "Continuous" ltype) lyr "")
)
)

(setq usrcmd (getvar "cmdecho"))
(setvar "cmdecho" 0)
(layer_setup "_diffuser" "1" "")

(if (and
(setq size_h (getdist "\nHeight: "))
(setq size_w (getdist "\nWidth: "))
)
(progn
(setq p1 (getvar "viewctr")
bang (atan size_h size_w)
bdiag (* (/ 1 (cos bang)) size_w)
)
(command "_.rectangle" p1 (polar p1 bang bdiag))
(prompt "\nPick Insertion Point: ")
(command "._move" (entlast) "" p1 pause)
(prompt "\nPick Angle: ")
(command "._rotate" (entlast) "" (getvar "lastpoint") pause)
)
)
(setvar "cmdecho" usrcmd)
(princ)
)
(prompt "\nDiffuser Loaded, Enter DIF to run.")
(princ)
(c:dif)

valerik88 Visual scale Function

27 Wednesday Jul 2016

Posted by danglar71 in Lisp Collection 2014, Utilites

≈ Leave a comment


;; valerik88 Visual scale Function
;; Saved from: http://forum.dwg.ru/showthread.php?t=132975
;; Partially Translated to English by Igal Averbuh 2016

(Defun C:vsc (/ gr vlaB p1 p2 p3 mas
sel len i blockDef objects vla inpmas *error* loopExit O OSM-LST OSMODE osm-lst)
(vl-load-com)
(setq aobj (vlax-get-acad-object))
(setq adoc (vla-get-ActiveDocument aobj))
(setq model_space (vla-get-ModelSpace adoc))
(setq csp (if (and (zerop (vla-get-activespace adoc))
(= :vlax-false (vla-get-mspace adoc))
)
(vla-get-paperspace adoc)
(vla-get-ModelSpace adoc)
)
)

(vla-startundomark adoc)

(defun *error* (msg)

;ּאסרעאבטנמגאםטו מעלוםוםמ
(if vlaB
(progn
(princ (strcat "\nVisual scale error: " msg "\n"))
(redraw)
;׃האכול בכמך
(vl-catch-all-apply '(lambda () (vla-delete vlaB)))

(setq vlaB (vla-insertblock csp (vlax-3d-point p1)(vla-get-name blockDef) 1.0 1.0 1.0 0.0))

(vla-Explode vlaB)

(vla-delete vlaB)
);end progn
);end if

(if (not sel)
(progn
(redraw)
(princ "\nThere is no selection set\n")
);end progn
);end if
(princ)
) ;_ end of defun

(setq p1 (getpoint "\nSelect objects for visual scaling "))

(setq osm-lst (osmode-grvecs-lst)
osmode (get_osmode)
);end setq

(while (or (= (car (setq gr (grread nil 5 0))) 5)
(= (car gr) 11)
(= (car gr) 25) ; For old version AutoCad
(= (car gr) 2)
)
(redraw)
(cond ((= (car gr) 5)
(setq o (osmodLoop gr osm-lst osmode))
(setq p2 (if o (osnap (caddr o) (cadr o)) (last gr)))
(if (not p2)(setq p2 (last gr)))
(drawRect p1 p2 7))

((= (car gr) 2)

(if (= (cadr gr) 6)
(progn
(changeOsmode)
(setq osmode (get_osmode))
);end progn
);end if
)
);end cond
);end while

(setq sel (ssget (if (>= (car p1) (car p2)) "_C" "_W") p1 p2))

(princ (strcat (itoa (sslength sel)) " selected\n"))

(setq blockDef (makeBlock sel p1))

(setq vlaB (vla-insertblock csp (vlax-3d-point p1)(vla-get-name blockDef) 1.0 1.0 1.0 0.0))

(while (and (or
(= (car (setq gr (grread nil 5 0))) 5)
(= (car gr) 11)
(= (car gr) 25) ; For old version AutoCad
(= (car gr) 2)
) (not loopExit);end or
);end and

(redraw)

(cond
;ֿנאגא ךםמןךא לרט םאזאעא
((= (car gr) 25)
(setq inpmas (getreal "Scale: "))
)
;ּאסרעאב גבנאם
( (= (car gr) 3) (setq loopExit t))
;ֲמהטל לר‏ ןמ ‎ךנאםף
( (= (car gr) 5)
(setq o (osmodLoop gr osm-lst osmode))
;׃האכול ןנמנטסמגאםםי בכמך
(vla-delete vlaB)
;ֲקטסכול םמגי לאסרעאב
(setq p3 (if o (osnap (caddr o) (cadr o)) (last gr)))
(if (not p3)(setq p3 (last gr)))
(setq mas (abs
(if inpmas
inpmas
(/ (- (car p1)(car p3))
(- (car p1)(car p2))
)
)
)
mas (if (zerop mas) 0.001 mas)
)

(if inpmas (setq loopExit t))

;׀טסףול ןףםךעטנםף‏ נאלךף
(drawRect p1 (list (+ (car p1) (* (abs(- (car p3)(car p1))) (if (> (car p2)(car p1)) 1 -1) )) (+ (cadr p1) (* (- (cadr p2) (cadr p1)) mas))) 9)
;׀טסףול חםאקוםטו לאסרעאבא נהמל ס ךףנסמנמל
(LM:DisplayGrText p3 (LM:GrText (strcat "Scale: " (rtos mas) "\nRight click - numeric input")) 3 15 -31)
;ֲסעאגכול בכמך ס לאסרעאבטנמגאםטול
(setq vlaB (vla-insertblock csp (vlax-3d-point p1)(vla-get-name blockDef) mas mas mas 0.0))
)

((= (car gr) 2)
;ֲךכ‏קוםטו/גךכ‏קוםטו ןנטגחךט ןמ F3
(if (= (cadr gr) 6)
(progn
(changeOsmode)
(setq osmode (get_osmode))
);end progn
);end if
)
);end cond
);end while

(redraw)
;׀אחבטגאול בכמך
(setq objects (vlax-safearray->list (vlax-variant-value (vla-Explode vlaB))))
;׃האכול בכמך
(vla-delete vlaB)

;ּוםול סגמיסעגא נאחלונםץ כטםטי
(setq len (length objects))
(setq i 0)
(while (ename vla))
;ֵסכט מבתוךע - נאחלונםי סעטכ
;(vlax-dump-Object vla)
(if
; (= (cdr (assoc '0 (entget n))) "DIMENSION")
(wcmatch (strcase (vla-get-ObjectName vla)) "*DIMENSION*")
; (progn
; ;׃סעאםאגכטגאול לאסרעאב נאחלונא
; (vlax-put-property vla 'LinearScaleFactor (/ (vlax-get-property vla 'LinearScaleFactor) mas))
; ;׃סעאםאגכטגאול גסמעף רנטפעא
; (vlax-put-property vla 'TextHeight (* (vlax-get-property vla 'TextHeight) mas))
; ;׃סעאםאגכטגאול מעסעףן מע סענוכךט
; (vlax-put-property vla 'TextGap (* (vlax-get-property vla 'TextGap) mas))
; ;׃סעאםאגכטגאול נאחלונ סענוכךט
; (vlax-put-property vla 'ArrowheadSize (* (vlax-get-property vla 'ArrowheadSize) mas))
; ;ֲםמסםו כטםטט
; (vlax-put-property vla 'ExtensionLineExtend (* (vlax-get-property vla 'ExtensionLineExtend) mas))
; (vlax-put-property vla 'ExtensionLineOffset (* (vlax-get-property vla 'ExtensionLineOffset) mas))
; );end progn

(foreach x
'(LinearScaleFactor TextHeight TextGap ArrowheadSize ExtensionLineExtend ExtensionLineOffset)
(if (vlax-property-available-p vla x)
(vl-catch-all-apply
'vlax-put-property
(list vla x ((eval (if (= x 'LinearScaleFactor) '/ '*))
(vlax-get-property vla x) mas)
)
)
)
)
);end if
(setq i (1+ i))
)

(vla-endundomark adoc)
(princ)
) ;end Defun mashtab

;ֲךכ‏קוםטו / גךכ‏קוםטו ןנטגחמך
(Defun changeOsmode ()
(setq osmode (getvar "OSMODE"))
(if (> osmode 16384)
(setvar "OSMODE" (- osmode 16384))
(setvar "OSMODE" (+ osmode 16384))
);end if
);end Defun

;ײטךכ ןנמגונךט ןנטגחךט
(Defun osmodLoop(gr osm-lst osmode / O s tp)
(if (or (= (car gr) 11)
(= (car gr) 25)
) ;_ or
(setq osmode (list(menu-pop500 gr)))
(progn

(if (setq
o (vl-remove-if
(function null)
(mapcar
(function
(lambda (x / o)
(if (setq o (osnap (cadr gr) x))
(list (distance (cadr gr) o) o x (cadr gr))
) ;_ if
) ;_ lambda
) ;_ function
osmode
) ;_ mapcar
) ;_ vl-remove-if
) ;_ setq
(setq
o (cdar
(vl-sort
o
(function
(lambda (a b)
(vla-object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))))
(vla-copyobjects
adoc
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray
vlax-vbobject
(cons 0 (1- (length lst)))
)
lst
)
)
blk_def
)
|;

;ֲסעאגכול ג בכמך ט ףהאכול גבנאםםו ‎כולוםע
;ֺמכ-גמ גבנאםםץ מבתוךעמג
(setq slen (SSLENGTH ss))
;׃האכול מבתוךע ט גסעאגכול טץ ג בכמך
(setq i 0)
(while (vla-object n))
blk_def
)

;׃האכול מבתוךע
(ENTDEL n)
(setq i (1+ i))
);end while

;ֲמחגנאשאול מןטסאםטו בכמךא
blk_def
);end Defun

;װףםךצט מענטסמגךט ןףםךעטנםמדמ ןנלמףדמכםטךא
(Defun drawRect(p1 p2 color / x1 x2 y1 y2 param)
(setq
x1 (car p1)
x2 (car p2)
y1 (cadr p1)
y2 (cadr p2)
param (if (>= x1 x2) 5 0)
)
(grdraw (list x1 y1)(list x1 y2) color param)
(grdraw (list x1 y2)(list x2 y2) color param)
(grdraw (list x2 y2)(list x2 y1) color param)
(grdraw (list x2 y1)(list x1 y1) color param)

);end Defun

;; Display GrText - Lee Mac
;; pnt - cursor point in UCS
;; vec - GrText vector list
;; col - Text Colour (ACI Colour)
;; xof - x-offset from cursor in pixels
;; yof - y-offset from cursor in pixels

(defun LM:DisplayGrText ( pnt vec col xof yof / scl )
(setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
pnt (trans pnt 1 2)
)
(grvecs (cons col vec)
(list
(list scl 0.0 0.0 (+ (car pnt) (* xof scl)))
(list 0.0 scl 0.0 (+ (cadr pnt) (* yof scl)))
(list 0.0 0.0 scl 0.0)
'(0.0 0.0 0.0 1.0)
)
)
)

;;-----------------------=={ GrText }==-----------------------;;
;; ;;
;; Returns a grvecs pixel vector list relative to the origin ;;
;; encoding the supplied string. ;;
;;------------------------------------------------------------;;
;; Author: Lee Mac, Copyright © 2013 - http://www.lee-mac.com ;;
;;------------------------------------------------------------;;
;; With thanks to ElpanovEvgeniy for the method of vector ;;
;; encoding to save me a lot of typing. ;;
;;------------------------------------------------------------;;
;; Arguments: ;;
;; str - String to be expressed in vector list format. ;;
;;------------------------------------------------------------;;
;; Returns: GrVecs Pixel Vector List relative to the Origin ;;
;;------------------------------------------------------------;;
;; Version 1.1 - 26-03-2011 ;;
;;------------------------------------------------------------;;

(defun LM:GrText ( str / asc lst vec xco yco )
(setq vec
'(
(033 045 045 065 135)
(034 104 134 107 137)
(035 043 063 046 066 084 094 087 097 115 135 118 138 072 078 103 109)
(036 025 035 052 052 043 047 058 078 083 087 092 112 123 127 118 118 135 135)
(037 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129 047 048 067 068 056 056 059 059 113 114 133 134 122 122 125 125)
(038 043 046 049 049 052 072 057 058 067 068 076 076 079 079 083 083 085 085 094 094 103 123 134 136 127 127)
(039 105 135)
(040 017 017 026 036 045 105 116 126 137 137)
(041 014 014 025 035 046 106 115 125 134 134)
(042 073 074 076 077 084 086 092 098 104 106 113 114 116 117)
(043 055 115 082 084 086 088)
(044 034 035 045 046 055 057)
(045 083 088)
(046 045 046 055 056)
(047 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129)
(048 044 047 134 137 053 123 058 128)
(049 044 048 124 125 056 136)
(050 043 048 053 053 064 064 075 075 086 086 097 097 108 128 134 137 123 123)
(051 053 053 044 047 058 088 095 097 108 128 134 137 123 123)
(052 046 048 057 137 078 078 073 076 083 083 094 094 105 115 126 126)
(053 053 053 044 047 058 088 094 097 093 133 134 138)
(054 044 047 058 088 095 097 084 084 053 113 124 124 135 137)
(055 044 054 065 075 086 096 107 117 128 138 133 137 123 123)
(056 044 047 094 097 134 137 053 083 058 088 103 123 108 128)
(057 044 046 057 057 068 128 097 097 084 086 134 137 093 123)
(058 045 046 055 056 095 096 105 106)
(059 034 035 045 046 055 057 095 096 105 106)
(060 047 047 056 056 065 065 074 074 083 083 094 094 105 105 116 116 127 127)
(061 073 078 093 098)
(062 043 043 054 054 065 065 076 076 087 087 096 096 105 105 114 114 123 123)
(063 045 045 065 075 086 086 097 097 108 128 134 137 123 123)
(064 034 038 043 043 052 112 123 123 134 137 128 128 079 119 068 068 065 066 105 106 077 107 074 094)
(065 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134)
(066 042 047 053 123 058 088 108 128 094 097 132 137)
(067 044 047 053 053 058 058 062 112 123 123 134 136 127 127 108 138)
(068 042 046 057 057 127 127 132 136 068 118 053 123)
(069 042 048 058 058 094 095 086 106 132 137 128 138 053 123)
(070 042 045 094 095 086 106 132 137 128 138 053 123)
(071 044 047 053 053 058 078 086 089 062 112 123 123 134 136 127 127 108 138)
(072 041 043 047 049 131 133 137 139 093 097 052 122 058 128)
(073 043 047 133 137 055 125)
(074 052 062 043 046 057 127 135 139)
(075 042 044 048 049 132 134 136 138 053 123 084 085 095 095 106 116 127 127 076 076 067 067 058 058)
(076 042 047 048 058 053 123 132 135)
(077 041 043 047 049 052 122 058 128 131 132 138 139 103 113 107 117 084 094 086 096 065 075)
(078 041 044 131 132 136 139 052 122 048 128 113 113 094 104 085 085 066 076 057 057)
(079 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118)
(080 042 045 084 087 132 137 053 123 098 128)
(081 134 136 123 123 127 127 112 062 118 068 053 053 057 057 044 046 035 036 023 024 027 028)
(082 042 044 048 049 132 137 123 053 128 098 084 087 076 076 067 067 058 058)
(083 042 062 053 053 044 047 058 078 086 087 093 095 102 122 133 136 127 127 118 138)
(084 043 047 055 125 132 138 131 121 139 129)
(085 044 046 052 053 057 058 062 122 068 128 131 133 137 139)
(086 045 055 064 074 066 076 083 103 087 107 112 122 118 128 131 133 137 139)
(087 043 063 047 067 072 092 074 094 076 096 078 098 101 121 105 115 109 129 131 132 138 139)
(088 041 043 047 049 131 133 137 139 052 052 058 058 063 063 067 067 074 074 076 076 085 095 104 104 106 106 113 113 117 117 122 122 128 128)
(089 043 047 055 085 094 094 096 096 103 113 107 117 122 122 128 128 131 133 137 139)
(090 122 122 058 058 132 138 042 048 128 128 052 052 063 063 074 074 085 095 106 106 117 117)
(091 015 017 135 137 025 125)
(092 122 122 113 113 104 104 095 095 086 086 077 077 068 068 059 059)
(093 014 016 134 136 026 126)
(094 102 102 113 113 124 124 135 135 126 126 117 117 108 108)
(095 021 029)
(096 125 125 134 134)
(097 043 046 048 048 052 072 057 097 083 086 103 106)
(098 042 043 045 046 054 054 057 058 068 098 097 097 105 106 094 094 132 132 053 133)
(099 044 046 053 053 057 058 052 092 093 093 104 106 097 098 108 108)
(100 044 045 047 048 052 092 053 053 056 056 093 093 104 105 096 096 136 136 057 137)
(101 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078)
(102 043 046 054 124 093 093 095 096 135 137 128 128)
(103 013 016 022 032 027 097 107 108 066 066 096 096 054 055 104 105 063 063 093 093 062 092)
(104 042 044 046 048 057 097 053 133 132 132 094 094 105 106)
(105 043 047 055 105 103 104 135 135)
(106 022 022 013 015 026 106 104 105 136 136)
(107 042 044 046 048 053 133 132 132 057 057 066 066 074 075 085 085 096 106 107 108)
(108 043 047 055 135 133 134)
(109 041 043 045 046 048 049 052 102 055 105 058 108 101 101 093 093 104 104 096 096 107 107)
(110 042 044 046 048 053 103 057 097 102 102 094 094 105 106)
(111 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098)
(112 012 015 023 103 102 102 054 054 094 094 045 046 105 106 057 058 097 098 068 088)
(113 015 018 027 107 108 108 056 056 096 096 044 045 104 105 052 053 092 093 062 082)
(114 042 046 054 104 102 103 095 095 106 108 099 099)
(115 052 052 043 047 058 068 073 077 082 092 103 107 098 098)
(116 045 047 058 058 054 124 102 103 105 107)
(117 102 102 106 106 053 103 056 056 044 045 047 107 048 048)
(118 045 045 054 064 056 066 073 083 077 087 092 092 098 098 101 103 107 109)
(119 043 053 047 057 062 092 064 084 066 086 068 098 101 103 095 105 107 109)
(120 042 044 046 048 102 104 106 108 053 053 057 057 093 093 097 097 064 064 066 066 084 084 086 086 075 075)
(121 012 013 024 024 035 045 054 064 056 066 073 083 077 087 092 092 098 098 101 103 107 109)
(122 092 092 058 058 102 108 042 048 097 097 086 086 075 075 064 064 053 053)
(123 016 017 025 065 073 074 085 125 136 137)
(124 015 135)
(125 014 015 026 066 077 078 086 126 134 135)
(126 112 122 133 134 125 125 116 117 128 138)
(145 114 116 125 126 136 137)
(146 114 115 125 126 135 137)
(161 045 115 135 135)
(162 026 036 045 047 058 058 054 054 053 093 094 094 098 098 105 107 116 126)
(163 043 048 054 074 083 086 094 094 103 123 134 136 117 127)
(164 083 083 088 088 133 133 138 138 094 097 124 127 104 114 107 117)
(165 044 046 055 075 081 089 094 094 096 096 101 103 107 109 113 113 117 117 122 122 128 128 131 133 137 139)
(166 015 055 095 135)
(167 042 042 032 036 047 047 056 057 065 065 074 074 083 083 092 102 068 078 087 087 096 096 105 105 113 114 123 123 134 138 128 128)
(168 134 134 137 137)
(169 054 057 063 063 068 068 072 122 079 129 133 133 138 138 144 147 075 076 087 087 084 114 125 126 117 117)
(170 063 067 084 086 088 088 093 103 097 127 114 116 134 136)
(171 055 055 064 064 073 073 082 082 093 093 104 104 115 115 058 058 067 067 076 076 085 085 096 096 107 107 118 118)
(172 068 098 092 097)
(173 083 088)
(174 054 057 063 063 068 068 072 122 079 129 133 133 138 138 144 147 074 124 095 096 125 126 077 087 107 117)
(175 151 159)
(176 105 106 114 124 117 127 135 136)
(177 042 048 092 098 065 085 105 125)
(178 084 087 095 095 106 106 117 127 135 136 124 124)
(179 094 094 085 086 097 107 116 116 127 127 135 136 124 124)
(180 125 125 136 136)
(181 012 012 023 113 044 047 049 049 058 118)
(182 045 045 049 049 048 128 046 126 133 139 122 125 112 115 102 105 092 095 083 085)
(183 085 086 095 096)
(184 014 015 026 026 035 035)
(185 084 086 124 124 095 135)
(186 063 067 084 086 134 136 093 123 097 127)
(187 052 052 063 063 074 074 085 085 094 094 103 103 112 112 055 055 066 066 077 077 088 088 097 097 106 106 115 115)
(188 048 098 059 059 055 057 065 065 076 076 087 087 083 133 122 122 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129)
(189 046 049 057 057 068 068 079 089 097 098 086 086 083 133 122 122 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129)
(190 048 098 059 059 055 057 065 065 076 076 087 087 092 092 083 084 095 105 114 114 125 125 133 134 122 122 052 052 063 063 074 074 085 085 096 096 107 107 118 118 129 129)
(191 044 047 058 058 053 073 084 084 095 095 106 116 136 136)
(192 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 155 155 164 164)
(193 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 155 155 166 166)
(194 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 154 154 165 165 156 156)
(195 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 152 152 163 165 155 157 168 168)
(196 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 163 163 167 167)
(197 041 043 047 049 052 062 058 068 073 077 083 093 087 097 104 114 106 116 125 135 133 134 145 145 154 154 165 165 156 156)
(198 041 043 045 049 052 062 073 093 104 114 125 125 084 085 059 059 056 126 097 098 088 088 108 108 134 139 129 129)
(199 044 047 053 053 058 058 062 112 123 123 134 136 127 127 108 138 014 015 026 026 035 035)
(200 042 048 058 058 094 095 086 106 132 137 128 138 053 123 156 156 165 165)
(201 042 048 058 058 094 095 086 106 132 137 128 138 053 123 155 155 166 166)
(202 042 048 058 058 094 095 086 106 132 137 128 138 053 123 154 154 165 166 157 157)
(203 042 048 058 058 094 095 086 106 132 137 128 138 053 123 164 164 167 167)
(204 043 047 133 137 055 125 155 155 164 164)
(205 043 047 133 137 055 125 155 155 166 166)
(206 043 047 133 137 055 125 154 154 165 165 156 156)
(207 043 047 133 137 055 125 163 163 167 167)
(208 042 046 057 057 127 127 132 136 068 118 053 123 091 092 094 095)
(209 041 044 131 132 137 139 052 122 048 128 113 113 094 104 085 085 066 076 057 057 152 152 163 165 155 157 168 168)
(210 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 155 155 164 164)
(211 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 155 155 166 166)
(212 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 154 154 165 165 156 156)
(213 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 152 152 163 165 155 157 168 168)
(214 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 163 163 167 167)
(215 052 052 063 063 074 074 085 085 096 096 107 107 118 118 058 058 067 067 076 076 094 094 103 103 112 112)
(216 044 046 053 053 057 057 123 123 127 127 134 136 062 112 068 118 043 043 064 074 085 095 106 116 137 137)
(217 044 046 052 053 057 058 062 122 068 128 131 133 137 139 155 155 164 164)
(218 044 046 052 053 057 058 062 122 068 128 131 133 137 139 155 155 166 166)
(219 044 046 052 053 057 058 062 122 068 128 131 133 137 139 154 154 165 165 156 156)
(220 044 046 052 053 057 058 062 122 068 128 131 133 137 139 163 163 167 167)
(221 044 046 055 085 094 094 096 096 103 113 107 117 122 122 128 128 131 133 137 139 145 155 166 166)
(222 042 044 132 132 053 133 074 077 104 107 088 098)
(223 042 042 043 123 134 136 107 127 095 096 087 087 058 078 045 047)
(224 043 046 048 048 052 072 057 097 083 086 103 106 125 125 134 134)
(225 043 046 048 048 052 072 057 097 083 086 103 106 125 125 136 136)
(226 043 046 048 048 052 072 057 097 083 086 103 106 124 124 135 135 126 126)
(227 043 046 048 048 052 072 057 097 083 086 103 106 122 122 133 134 125 126 137 137)
(228 043 046 048 048 052 072 057 097 083 086 103 106 133 133 137 137)
(229 043 046 048 048 052 072 057 097 083 086 103 106 125 125 134 134 145 145 136 136)
(230 042 044 046 048 059 059 051 071 082 084 102 104 055 095 076 079 089 099 106 108)
(231 014 015 026 026 035 035 044 046 053 053 057 058 052 092 093 093 104 106 097 098 108 108)
(232 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078 125 125 134 134)
(233 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078 125 125 136 136)
(234 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078 124 124 135 135 126 126)
(235 044 046 053 053 057 058 052 092 093 093 104 106 097 098 088 088 073 078 133 133 137 137)
(236 043 047 055 105 103 104 125 125 134 134)
(237 043 047 055 105 103 104 124 124 135 135)
(238 043 047 055 105 103 104 124 124 135 135 126 126)
(239 043 047 055 105 103 104 133 133 136 136)
(240 044 046 053 053 057 057 052 082 058 088 083 083 087 107 094 096 116 116 113 114 125 125 134 134 136 137)
(241 042 044 046 048 053 103 057 097 102 102 094 094 105 106 122 122 133 134 125 126 137 137)
(242 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 125 125 134 134)
(243 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 125 125 136 136)
(244 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 124 124 135 135 126 126)
(245 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 122 122 133 135 125 127 138 138)
(246 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 133 133 137 137)
(247 055 055 115 115 082 088)
(248 044 046 104 106 053 053 057 057 093 093 097 097 052 092 058 098 042 042 064 064 075 075 086 086 108 108)
(249 102 102 106 106 053 103 056 056 044 045 047 107 048 048 125 125 134 134)
(250 102 102 106 106 053 103 056 056 044 045 047 107 048 048 125 125 136 136)
(251 102 102 106 106 053 103 056 056 044 045 047 107 048 048 124 124 135 135 126 126)
(252 102 102 106 106 053 103 056 056 044 045 047 107 048 048 133 133 137 137)
(253 012 013 024 024 035 045 054 064 056 066 073 083 077 087 092 092 098 098 101 103 107 109 125 125 136 136)
(254 012 015 132 132 023 133 054 054 045 046 057 058 068 088 094 094 105 106 097 098)
(255 012 013 024 024 035 045 054 064 056 066 073 083 077 087 092 092 098 098 101 103 107 109 133 133 137 137)
)
)
(eval
(list 'defun 'LM:GrText '( str / asc lst vec xco yco )
(list 'setq 'vec
(list 'quote
(mapcar
(function
(lambda ( b )
(cons (car b)
(mapcar
(function
(lambda ( a )
(list (rem a 10) (/ a 10))
)
)
(cdr b)
)
)
)
)
vec
)
)
)
'(setq xco 0 yco 0)
'(repeat (strlen str)
(setq asc (ascii str)
str (substr str 2)
)
(cond
( (= 32 asc)
(setq xco (+ xco 09))
)
( (= 09 asc)
(setq xco (+ xco 36))
)
( (= 10 asc)
(setq xco 0
yco (- yco 16)
)
)
( (setq lst
(cons
(mapcar
(function
(lambda ( a )
(list (+ (car a) xco) (+ (cadr a) yco))
)
)
(cdr (assoc asc vec))
)
lst
)
)
(setq xco (+ xco 9))
)
)
)
'(apply 'append lst)
)
)
(LM:GrText str)
)

(defun menu-pop500 (d / lst s)
; Choice function of OSNAP through the shortcut menu.
; Only, as an example.
; Is checked up in AutoCad 2004-2007 (En)
; by ElpanovEvgeniy
; (2006-10-11)
; (menu-pop500 (grread t 5))
(setq
lst (reverse
(menu-index
((lambda (x) (list (1- (vla-get-count x)) x))
(vla-item
(vla-get-menus
(vla-item
(vla-get-menugroups
(vlax-get-acad-object)
) ;_ vla-get-MenuGroups
"ACAD"
) ;_ vla-item
) ;_ vla-get-Menus
"&Object Snap Cursor Menu"
) ;_ vla-item
)
) ;_ menu-index
) ;_ reverse
) ;_ setq
(while (and
(listp d)
(or (= (car d) 5)
(= (car d) 11)
(= (car d) 12)
(= (car d) 25) ; For old version AutoCad
) ;_ or
) ;_ and
(cond
((= (car d) 25) (menucmd "POP500=*")) ; For old version AutoCad
((equal d '(11 0)) (menucmd "POP500=*"))
((= (car d) 11) (setq s (nth (- (cadr d) 500) lst)))
) ;_ cond
(if s
(setq d s)
(setq d (grread t 5))
) ;_ if
) ;_ while
(substr s 1 4)
) ;_ defun
(defun menu-index (l)
; Creation of the list of choices of choice of OSNAP
; Is checked up in AutoCad 2004-2007 (En)
; by ElpanovEvgeniy
; (2006-10-11)
;|
(menu-index
((lambda (x) (list (1-(vla-get-count x)) x))
(vla-item
(vla-get-menus
(vla-item
(vla-get-menugroups
(vlax-get-acad-object)
) ;_ vla-get-MenuGroups
"ACAD"
) ;_ vla-item
) ;_ vla-get-Menus
"&Object Snap Cursor Menu"
) ;_ vla-item
)
) ;_ menu-index
|;
(if (not (minusp (car l)))
(cond
((= (vla-get-type (vla-item (cadr l) (car l))) 0)
(cons
(vla-get-macro (vla-item (cadr l) (car l)))
(menu-index (cons (1- (car l)) (cdr l)))
) ;_ cons
)
((= (vla-get-type (vla-item (cadr l) (car l))) 1)
(menu-index (cons (1- (car l)) (cdr l)))
)
((= (vla-get-type (vla-item (cadr l) (car l))) 2)
(append
(menu-index
((lambda (x) (list (1- (vla-get-count x)) x))
(vla-get-submenu (vla-item (cadr l) (car l)))
) ;_ menu-index
) ;_ menu-index
(menu-index (cons (1- (car l)) (cdr l)))
) ;_ append
)
) ;_ cond
) ;_ if
) ;_ defun
(defun get_osmode nil
; Function create list osmode macro
; for result (getvar "OSMODE")
; by Evgeniy Elpanov
; (get_osmode)
(mapcar
(function cdr)
(vl-remove-if
(function
(lambda (x)
(zerop (logand (getvar "OSMODE") (car x)))
) ;_ lambda
) ;_ function
(append
(if (< 0 (setq cur_mode (getvar "osmode")) 16384)
'((1 . "_end")
(2 . "_mid")
(4 . "_cen")
(8 . "_nod")
(16 . "_qua")
(32 . "_int")
;(4096 . "_ext") ; Is not realized
)
) ;_ if
(if (not (zerop (logand (getvar "autosnap") 16)))
'((64 . "_ins")
(128 . "_per")
(256 . "_tan")
(512 . "_nea")
;(1024 . "_qui") ; Is not realized
(2048 . "_app")
;(8192 . "_par") ; Is not realized
)
) ;_ if
) ;_ append
) ;_ substr
) ;_ mapcar
) ;_ defun

(defun osmode-grvecs-lst (/ -ASS ASS COL)
; Function create list
; for drawing icons osmode with the function grvecs
; by Evgeniy Elpanov
; (osmode-grvecs-lst)
(setq
col (atoi (getenv "AutoSnapColor"))
ass (atof (getenv "AutoSnapSize"))
-ass (- ass)
) ;_ setq
(list
(list
"tracking"
col
(list (* -ass 0.2) 0.)
(list (* ass 0.2) 0.)
col
(list 0. (* -ass 0.2))
(list 0. (* ass 0.2))
) ;_ list
(list
"_end"
col
(list -ass -ass)
(list -ass ass)
col
(list (1- -ass) (1- -ass))
(list (1- -ass) (1+ ass))
col
(list -ass ass)
(list ass ass)
col
(list (1- -ass) (1+ ass))
(list (1+ ass) (1+ ass))
col
(list ass ass)
(list ass -ass)
col
(list (1+ ass) (1+ ass))
(list (1+ ass) (1- -ass))
col
(list ass -ass)
(list -ass -ass)
col
(list (1+ ass) (1- -ass))
(list (1- -ass) (1- -ass))
) ;_ list
(list
"_mid"
col
(list -ass -ass)
(list 0. ass)
col
(list (1- -ass) (1- -ass))
(list 0. (1+ ass))
col
(list 0. ass)
(list ass -ass)
col
(list 0. (1+ ass))
(list (1+ ass) (1- -ass))
col
(list ass -ass)
(list -ass -ass)
col
(list (1+ ass) (1- -ass))
(list (1- -ass) (1- -ass))
) ;_ list
(list
"_cen"
7
(list (* -ass 0.2) 0.)
(list (* ass 0.2) 0.)
7
(list 0. (* -ass 0.2))
(list 0. (* ass 0.2))
col
(list -ass 0.)
(list (* -ass 0.86) (* ass 0.5))
col
(list (* -ass 0.86) (* ass 0.5))
(list (* -ass 0.5) (* ass 0.86))
col
(list (* -ass 0.5) (* ass 0.86))
(list 0. ass)
col
(list 0. ass)
(list (* ass 0.5) (* ass 0.86))
col
(list (* ass 0.5) (* ass 0.86))
(list (* ass 0.86) (* ass 0.5))
col
(list (* ass 0.86) (* ass 0.5))
(list ass 0.)
col
(list ass 0.)
(list (* ass 0.86) (* -ass 0.5))
col
(list (* ass 0.86) (* -ass 0.5))
(list (* ass 0.5) (* -ass 0.86))
col
(list (* ass 0.5) (* -ass 0.86))
(list 0. -ass)
col
(list 0. -ass)
(list (* -ass 0.5) (* -ass 0.86))
col
(list (* -ass 0.5) (* -ass 0.86))
(list (* -ass 0.86) (* -ass 0.5))
col
(list (* -ass 0.86) (* -ass 0.5))
(list -ass 0.)
) ;_ list
(list
"_nod"
col
(list -ass -ass)
(list ass ass)
col
(list -ass ass)
(list ass -ass)
col
(list -ass 0.)
(list (* -ass 0.86) (* ass 0.5))
col
(list (* -ass 0.86) (* ass 0.5))
(list (* -ass 0.5) (* ass 0.86))
col
(list (* -ass 0.5) (* ass 0.86))
(list 0. ass)
col
(list 0. ass)
(list (* ass 0.5) (* ass 0.86))
col
(list (* ass 0.5) (* ass 0.86))
(list (* ass 0.86) (* ass 0.5))
col
(list (* ass 0.86) (* ass 0.5))
(list ass 0.)
col
(list ass 0.)
(list (* ass 0.86) (* -ass 0.5))
col
(list (* ass 0.86) (* -ass 0.5))
(list (* ass 0.5) (* -ass 0.86))
col
(list (* ass 0.5) (* -ass 0.86))
(list 0. -ass)
col
(list 0. -ass)
(list (* -ass 0.5) (* -ass 0.86))
col
(list (* -ass 0.5) (* -ass 0.86))
(list (* -ass 0.86) (* -ass 0.5))
col
(list (* -ass 0.86) (* -ass 0.5))
(list -ass 0.)
) ;_ list
(list
"_qua"
col
(list 0. -ass)
(list -ass 0.)
col
(list 0. (1- -ass))
(list (1- -ass) 0.)
col
(list -ass 0.)
(list 0. ass)
col
(list (1- -ass) 0.)
(list 0. (1+ ass))
col
(list 0. ass)
(list ass 0.)
col
(list 0. (1+ ass))
(list (1+ ass) 0.)
col
(list ass 0.)
(list 0. -ass)
col
(list (1+ ass) 0.)
(list 0. (1- -ass))
) ;_ list
(list
"_int"
col
(list -ass -ass)
(list ass ass)
col
(list -ass (1+ -ass))
(list ass (1+ ass))
col
(list (1+ -ass) -ass)
(list (1+ ass) ass)
col
(list -ass ass)
(list ass -ass)
col
(list -ass (1+ ass))
(list ass (1+ -ass))
col
(list (1+ -ass) ass)
(list (1+ ass) -ass)
) ;_ list
(list
"_ins"
col
(list (* -ass 0.1) (* -ass 0.1))
(list -ass (* -ass 0.1))
col
(list -ass (* -ass 0.1))
(list -ass ass)
col
(list -ass ass)
(list (* ass 0.1) ass)
col
(list (* ass 0.1) ass)
(list (* ass 0.1) (* ass 0.1))
col
(list (* ass 0.1) (* ass 0.1))
(list ass (* ass 0.1))
col
(list ass (* ass 0.1))
(list ass -ass)
col
(list ass -ass)
(list (* -ass 0.1) -ass)
col
(list (* -ass 0.1) -ass)
(list (* -ass 0.1) (* -ass 0.1))
col
(list (1- (* -ass 0.1)) (1- (* -ass 0.1)))
(list (1- -ass) (1- (* -ass 0.1)))
col
(list (1- -ass) (1- (* -ass 0.1)))
(list (1- -ass) (1+ ass))
col
(list (1- -ass) (1+ ass))
(list (1+ (* ass 0.1)) (1+ ass))
col
(list (1+ (* ass 0.1)) (1+ ass))
(list (1+ (* ass 0.1)) (1+ (* ass 0.1)))
col
(list (1+ (* ass 0.1)) (1+ (* ass 0.1)))
(list (1+ ass) (1+ (* ass 0.1)))
col
(list (1+ ass) (1+ (* ass 0.1)))
(list (1+ ass) (1- -ass))
col
(list (1+ ass) (1- -ass))
(list (1- (* -ass 0.1)) (1- -ass))
col
(list (1- (* -ass 0.1)) (1- -ass))
(list (1- (* -ass 0.1)) (1- (* -ass 0.1)))
) ;_ list
(list
"_tan"
col
(list -ass ass)
(list ass ass)
col
(list (1- -ass) (1+ ass))
(list (1+ ass) (1+ ass))
col
(list -ass 0.)
(list (* -ass 0.86) (* ass 0.5))
col
(list (* -ass 0.86) (* ass 0.5))
(list (* -ass 0.5) (* ass 0.86))
col
(list (* -ass 0.5) (* ass 0.86))
(list 0. ass)
col
(list 0. ass)
(list (* ass 0.5) (* ass 0.86))
col
(list (* ass 0.5) (* ass 0.86))
(list (* ass 0.86) (* ass 0.5))
col
(list (* ass 0.86) (* ass 0.5))
(list ass 0.)
col
(list ass 0.)
(list (* ass 0.86) (* -ass 0.5))
col
(list (* ass 0.86) (* -ass 0.5))
(list (* ass 0.5) (* -ass 0.86))
col
(list (* ass 0.5) (* -ass 0.86))
(list 0. -ass)
col
(list 0. -ass)
(list (* -ass 0.5) (* -ass 0.86))
col
(list (* -ass 0.5) (* -ass 0.86))
(list (* -ass 0.86) (* -ass 0.5))
col
(list (* -ass 0.86) (* -ass 0.5))
(list -ass 0.)
) ;_ list
(list
"_per"
col
(list -ass -ass)
(list -ass ass)
col
(list (1- -ass) (1- -ass))
(list (1- -ass) (1+ ass))
col
(list ass -ass)
(list -ass -ass)
col
(list (1+ ass) (1- -ass))
(list (1- -ass) (1- -ass))
col
(list -ass 0.)
(list 0. 0.)
col
(list -ass -1.)
(list 0. -1.)
col
(list 0. 0.)
(list 0. -ass)
col
(list -1. 0.)
(list -1. -ass)
) ;_ list
(list
"_nea"
col
(list -ass -ass)
(list ass ass)
col
(list -ass ass)
(list ass ass)
col
(list (1- -ass) (1+ ass))
(list (1+ ass) (1+ ass))
col
(list -ass ass)
(list ass -ass)
col
(list ass -ass)
(list -ass -ass)
col
(list (1+ ass) (1- -ass))
(list (1- -ass) (1- -ass))
) ;_ list
(list
"_app"
col
(list -ass -ass)
(list ass ass)
col
(list ass -ass)
(list -ass ass)

col
(list -ass -ass)
(list -ass ass)
col
(list (1- -ass) (1- -ass))
(list (1- -ass) (1+ ass))
col
(list -ass ass)
(list ass ass)
col
(list (1- -ass) (1+ ass))
(list (1+ ass) (1+ ass))
col
(list ass ass)
(list ass -ass)
col
(list (1+ ass) (1+ ass))
(list (1+ ass) (1- -ass))
col
(list ass -ass)
(list -ass -ass)
col
(list (1+ ass) (1- -ass))
(list (1- -ass) (1- -ass))
) ;_ list
;; Is not realized
;; (list
;; "_par"
;; col
;; (list (* -ass 0.8) -ass)
;; (list ass (* ass 0.8))
;; col
;; (list -ass (* -ass 0.8))
;; (list (* ass 0.8) ass)
;; )

) ;_ list
) ;_ defun
(c:vsc)

Split a column of text by crossing line (Text Trim)

10 Sunday Jul 2016

Posted by danglar71 in Lisp Collection 2014, Text

≈ Leave a comment

;;; Split a column of text by crossing line
;;; Created by Henrique
;;; Saved from: http://forums.autodesk.com/t5/visual-lisp-autolisp-and-general/split-a-column-of-text-by-crossing-line/td-p/6386747/page/3

(vl-load-com)
(defun c:tb (/ bbox char hnd i lineobj lst n newins newobj newstr pt1 pt2 ptint pts ss ss1 str textobj)
(defun bbox (vla-obj / brpt ll llpt ur urpt)
(vla-getboundingbox vla-obj 'll 'ur)
(setq llpt (vlax-safearray->list ll)
urpt (vlax-safearray->list ur)
brpt (list (car urpt) (cadr llpt) (caddr llpt))
)
(list llpt brpt)
)
(if (and (princ "\nSelect column of text to split by crossing line : ")
(setq ss (ssget ":L" '((0 . "TEXT"))))
(princ "\nSelect line to split text: ")
(setq ss1 (ssget "_+.:E:S" '((0 . "LINE"))))
)
(progn
(setq lineobj (vlax-ename->vla-object (ssname ss1 0))
pt1 (vlax-get lineobj 'startpoint)
pt2 (vlax-get lineobj 'endpoint)
)
(repeat (setq i (sslength ss))
(setq hnd (ssname ss (setq i (1- i)))
textobj (vlax-ename->vla-object hnd)
pts (bbox textobj)
)
(if (setq ptint (inters (car pts) (cadr pts) pt1 pt2))
(progn
(setq str (vla-get-textstring textobj)
lst (vl-string->list str)
n 0
newstr ""
)
(while (null newins)
(setq newstr (strcat newstr
(if (= (setq char (chr (nth n lst))) " ")
"("
char
)
)
)
(vla-put-textstring textobj newstr)
(setq pts (bbox textobj))
(if (not (setq newins (inters (car pts) (cadr pts) pt1 pt2)))
(setq n (1+ n))
)
)
(vla-put-textstring textobj (substr str 1 n))
(command "_.copy" hnd "" "_none" (vlax-get textobj 'insertionpoint) "_none" newins)
(setq newins nil
lst nil
)
(setq newobj (vlax-ename->vla-object (entlast)))
(vla-put-textstring newobj (substr str (1+ n)))
)
)
)
)
)
(princ)
)
(c:tb)

Makes selected objects temporarily invisible until next regeneration

10 Sunday Jul 2016

Posted by danglar71 in Lisp Collection 2014, Utilites

≈ Leave a comment


; Makes selected objects temporarily invisible until next regeneration.
;-------------------------------------------------------------------------------
;Copyright (C) 2008 Rolf Wischnewski
;www.CADmaro.de
;-------------------------------------------------------------------------------
(defun c:el (/ :ss-for)
;; -----------------------------------------
(defun :ss-for (#selset #expr / :ssfor:i)
(if #selset
(repeat (setq :ssfor:i (sslength #selset))
((eval #expr) (ssname #selset (setq :ssfor:i (1- :ssfor:i))))
)
)
)
;; -----------------------------------------
;;
(:ss-for (ssget) (function (lambda (ent) (redraw ent 2))))
)
(c:el)

← Older posts

Recent Posts

  • Это наша плата за трусость
  • Set the Default Application to open DWG Files
  • Draw “Heat Grid” (Lee Mac)
  • PROGRAM FOR SPRINKLER DISTRIBUTION
  • How to remove Frames around blocks

Recent Comments

Wilmer Lacayo on Draw Centroid (center of gravi…
Jun on Convert Polylines to Leaders i…
Adel on HVAC Draw Branch Duct
danglar71 on Draw “Heat Grid” (…
IOAN VLAD on Draw “Heat Grid” (…

Archives

  • January 2021
  • March 2020
  • February 2020
  • January 2020
  • October 2019
  • September 2019
  • August 2019
  • July 2019
  • June 2019
  • May 2019
  • April 2019
  • February 2019
  • January 2019
  • December 2018
  • November 2018
  • October 2018
  • September 2018
  • August 2018
  • July 2018
  • June 2018
  • April 2018
  • March 2018
  • February 2018
  • January 2018
  • December 2017
  • November 2017
  • August 2017
  • July 2017
  • June 2017
  • May 2017
  • April 2017
  • March 2017
  • February 2017
  • January 2017
  • December 2016
  • November 2016
  • October 2016
  • September 2016
  • August 2016
  • July 2016
  • June 2016
  • May 2016
  • April 2016
  • March 2016
  • February 2016
  • January 2016
  • December 2015
  • November 2015
  • October 2015
  • September 2015
  • August 2015
  • July 2015
  • June 2015
  • May 2015
  • April 2015
  • March 2015
  • February 2015
  • January 2015
  • December 2014
  • November 2014

Categories

  • 3D
  • Annonymous Blocks
  • Attribute
  • Batch
  • Blocks
  • Books
  • Common
  • Coordinates
  • Counting
  • dimmensions
  • draw
  • Export
  • Fractal
  • Hatch
  • HVAC
  • Images
  • Import
  • Info
  • Isometric
  • Layers
  • Layouts
  • Lisp Collection 2014
  • Mline
  • Pdf
  • Pipes
  • plot
  • Points
  • Protect
  • Text
  • Tips (English)
  • Tips (Russian)
  • ucs
  • Utilites
  • view
  • Vport
  • Xref

Recent Posts

  • Это наша плата за трусость
  • Set the Default Application to open DWG Files
  • Draw “Heat Grid” (Lee Mac)
  • PROGRAM FOR SPRINKLER DISTRIBUTION
  • How to remove Frames around blocks

Recent Comments

Wilmer Lacayo on Draw Centroid (center of gravi…
Jun on Convert Polylines to Leaders i…
Adel on HVAC Draw Branch Duct
danglar71 on Draw “Heat Grid” (…
IOAN VLAD on Draw “Heat Grid” (…

Archives

  • January 2021
  • March 2020
  • February 2020
  • January 2020
  • October 2019
  • September 2019
  • August 2019
  • July 2019
  • June 2019
  • May 2019
  • April 2019
  • February 2019
  • January 2019
  • December 2018
  • November 2018
  • October 2018
  • September 2018
  • August 2018
  • July 2018
  • June 2018
  • April 2018
  • March 2018
  • February 2018
  • January 2018
  • December 2017
  • November 2017
  • August 2017
  • July 2017
  • June 2017
  • May 2017
  • April 2017
  • March 2017
  • February 2017
  • January 2017
  • December 2016
  • November 2016
  • October 2016
  • September 2016
  • August 2016
  • July 2016
  • June 2016
  • May 2016
  • April 2016
  • March 2016
  • February 2016
  • January 2016
  • December 2015
  • November 2015
  • October 2015
  • September 2015
  • August 2015
  • July 2015
  • June 2015
  • May 2015
  • April 2015
  • March 2015
  • February 2015
  • January 2015
  • December 2014
  • November 2014

Categories

  • 3D
  • Annonymous Blocks
  • Attribute
  • Batch
  • Blocks
  • Books
  • Common
  • Coordinates
  • Counting
  • dimmensions
  • draw
  • Export
  • Fractal
  • Hatch
  • HVAC
  • Images
  • Import
  • Info
  • Isometric
  • Layers
  • Layouts
  • Lisp Collection 2014
  • Mline
  • Pdf
  • Pipes
  • plot
  • Points
  • Protect
  • Text
  • Tips (English)
  • Tips (Russian)
  • ucs
  • Utilites
  • view
  • Vport
  • Xref

Create a free website or blog at WordPress.com.

Privacy & Cookies: This site uses cookies. By continuing to use this website, you agree to their use.
To find out more, including how to control cookies, see here: Cookie Policy