Autocad Lisp Draw Roof Line
AutoLISP: Create a Roof Pitch Symbol
If you need to create a roof pitch symbol this routine will surely help.
Here's how:
- PS <enter> to start "Pitch Symbol"
- Select a line that has the slope that you need to calculate
- Specify the base length of the symbol. (This is the horizontal line of the triangle). this can be done by entering a value in the command line or by picking 2 points
- Specify what side of the line you want the symbol to be placed on.
- Move the symbol into place
Note that the symbol created is not a block, it is a group
;; PITCH.LSP ( defun c:pitch_symbol ( / a b c f g h i j k l m n p oldosmode) ( if ( = ( getvar "dimscale" ) 0 ) ( setvar "dimscale" 1 )) ( setq oldosmode ( getvar "osmode" )) ( setvar "osmode" 0 ) ( cond (( not ( setq a ( entsel "\nSelect LINE: " )))) (( /= "LINE" ( cdr ( assoc 0 ( setq c ( entget ( car a)))))) ( alert "Object selected is not a LINE segment." )) (( not ( setq b ( angle ( cdr ( assoc 10 c)) ( cdr ( assoc 11 c)))))) (( apply 'or ( mapcar '= ( list 0 ( * pi 0.5 ) pi ( * pi 1.5 ) ( * pi 2 )) ( list b b b b b))) ( alert "Object selected has no pitch value." )) ( t ( if ( not PITCH_BASE) ( setq PITCH_BASE ( getvar "dimdli" ))) ( if ( not ( setq c ( getdist ( strcat "\nBase length <" ( rtos PITCH_BASE) ">: " )))) ( setq c PITCH_BASE) ( setq PITCH_BASE c) ) ( setq h ( * ( getvar "dimscale" ) ( getvar "dimgap" ))) ( setq d ( angle ( setq e ( cdr ( assoc 10 ( setq b ( entget ( car a)))))) ( setq f ( cdr ( assoc 11 b))) ) ) ( setq a ( inters e f ( cadr a) ( polar ( cadr a) ( + d ( * pi 0.5 )) 12 ) nil)) ( if ( or ( < ( * 0.25 pi) d ( * 0.75 pi)) ( < ( * 1.25 pi) d ( * 1.75 pi)) ) ( progn ( setq e ( / ( abs ( cos d)) ( abs ( sin d)))) ) ( progn ( setq e ( / ( abs ( sin d)) ( abs ( cos d)))) ) ) ( setq g "12" f ( rtos ( * e 12.0 ) 4 4 )) ( setq f ( if ( = f "1'" ) "12" ( setq f ( substr f 1 ( 1- ( strlen f)))))) ( if ( < pi d ( * 2 pi)) ( setq d ( - d pi))) ( cond (( < 0 d ( * pi 0.25 )) ( setq f ( list ( list ( + d ( * pi 0.5 )) pi c ( * pi 1.5 ) ( * e c) ( list "C" ( * pi 0.5 ) g) ( list "MR" pi f)) ( list ( + d ( * pi 1.5 )) ( * pi 1.5 ) ( * e c) pi c ( list "ML" 0 f) ( list "TC" ( * pi 1.5 ) g)) ) ) ) (( <= ( * pi 0.25 ) d ( * pi 0.50 )) ( setq f ( list ( list ( + d ( * pi 0.5 )) pi ( * e c) ( * pi 1.5 ) c ( list "C" ( * 0.5 ) g) ( list "MR" pi f)) ( list ( + d ( * pi 1.5 )) ( * pi 1.5 ) c pi ( * e c) ( list "ML" 0 f) ( list "TC" ( * pi 1.5 ) g)) ) ) ) (( < ( * pi 0.50 ) d ( * pi 0.75 )) ( setq f ( list ( list ( + d ( * pi 1.5 )) 0 ( * e c) ( * pi 1.5 ) c ( list "C" ( * pi 0.5 ) f) ( list "ML" 0 g)) ( list ( + d ( * pi 0.5 )) ( * pi 1.5 ) c 0 ( * e c) ( list "MR" pi g) ( list "TC" ( * pi 1.5 ) f)) ) ) ) (( <= ( * pi 0.75 ) d pi) ( setq f ( list ( list ( + d ( * pi 1.5 )) 0 c ( * pi 1.5 ) ( * e c) ( list "C" ( * pi 0.5 ) g) ( list "ML" 0 f)) ( list ( + d ( * pi 0.5 )) ( * pi 1.5 ) ( * e c) 0 c ( list "MR" pi f) ( list "TC" ( * pi 1.5 ) g)) ) ) ) ) ( setq ad nil jp nil cp nil) ( foreach j f ( setq p1 ( polar a ( car j) h)) ( setq p2 ( polar p1 ( cadr j) ( caddr j))) ( setq p3 ( polar p2 ( cadddr j) ( nth 4 j))) ( setq ad ( append ad ( list ( list 256 p1 p2 p2 p3 p3 p1)))) ( setq jp ( append jp ( list ( list ( nth 5 j) ( nth 6 j))))) ( setq cp ( append cp ( list p1 p3))) ) ( setq p1 ( car cp) p2 ( cadr cp) p3 ( caddr cp) p4 ( cadddr cp)) ( setq d1 ( car ad) d2 ( cadr ad) t1 d1 t2 0 ) ( grvecs d1) ( princ "\n[DRAG] Pitch symbol and [PICK]: " ) ( grread 5 ) ( while ( /= 3 ( car ( setq l ( grread 5 )))) ( if ( = 5 ( car l)) ( progn ( setq n ( distance ( cadr l) ( inters ( cadr l) ( polar ( cadr l) ( + d ( * pi 0.5 )) 12.0 ) p1 p2 nil))) ( setq m ( distance ( cadr l) ( inters ( cadr l) ( polar ( cadr l) ( + d ( * pi 0.5 )) 12.0 ) p3 p4 nil))) ( if ( < n m) ( if ( not ( equal t1 d1)) ( progn ( grvecs t1) ( grvecs d1) ( setq t1 d1 t2 0 ) ) ) ( if ( not ( equal t1 d2)) ( progn ( grvecs t1) ( grvecs d2) ( setq t1 d2 t2 1 ) ) ) ) ) ) ) ( grvecs t1) ( setq d1 ( cdr t1)) ( setq f ( mapcar 'getvar ' ( "highlight" "cecolor" ))) ( command "._pline" ( setq p1 ( nth 0 d1)) "w" "0" "" ( setq p2 ( nth 1 d1)) ( setq p3 ( nth 3 d1)) "c" ) ( setq e ( entlast )) ( setq t2 ( nth t2 jp)) ( setq d1 ( polar p1 ( angle p1 p2) ( / ( distance p1 p2) 2 ))) ( setq d1 ( polar d1 ( cadr ( car t2)) h)) ( setq d2 ( polar p2 ( angle p2 p3) ( / ( distance p2 p3) 2 ))) ( setq d2 ( polar d2 ( cadr ( cadr t2)) h)) ( if ( >= ( atoi ( getvar "acadver" )) 12 ) ( setvar "cecolor" ( itoa ( getvar "dimclrt" ))) ) ( command "._text" "j" ( car ( car t2)) d1 ( * ( getvar "dimscale" ) ( getvar "dimtxt" )) "0" ( caddr ( car t2))) ( command "._text" "j" ( car ( cadr t2)) d2 ( * ( getvar "dimscale" ) ( getvar "dimtxt" )) "0" ( caddr ( cadr t2))) ( if ( and e ( >= ( atoi ( getvar "acadver" )) 13 )) ( progn ( setvar "highlight" 0 ) ( setq d ( ssadd e)) ( while ( setq e ( entnext e)) ( setq d ( ssadd e d))) ( command "._-group" "_create" "*" "Pitch Symbol" d "" ) ) ) ( mapcar 'setvar ' ( "highlight" "cecolor" ) f) ( setvar "osmode" oldosmode) ) ) ( princ ) ) ( defun c:ps () (c:pitch_symbol)) ( princ "\nC:Pitch_Symbol is now loaded." ) ( princ "\nType PS to start command." ) ( princ ) 
This entry was posted in AutoLISP, AutoLISP: Creating. Bookmark the permalink.
Source: https://autocadtips1.com/2012/07/23/autolisp-create-a-roof-pitch-symbol/
0 Response to "Autocad Lisp Draw Roof Line"
إرسال تعليق