MEMBUAT LAMBANG ELEVASI AUTOCAD LiSP
"Biasakan meng-copy Program LiSP tanpa menghapus nama penciptanya"
;n.pranyoto@gmail.com 060214 membuat lambang elevasi;
;elevation mark creator;
;------------------------------------------------
(defun C:elm (/)
(if (not (tblsearch "LAYER" "ELV_MARK"))
(progn
(entmake (list (cons 0 "LAYER")
(cons 100 "AcDbSymbolTableRecord")
(cons 100 "AcDbLayerTableRecord")
(cons 2 "ELV_MARK")
)
)
)
)
(if (not (tblsearch "STYLE" "ELV_MARK"))
(progn
(command "_.STYLE" "ELV_MARK" "romans.SHX" "0" "0.75" "0" "" "" "")
)
)
;set skala
(setq SkalaEL (getint "\nMasukan skala gambar: "))
;set datum
(setq datumpoint (getpoint "\nPilih posisi datum: "))
(setq stdatumelev (getstring "\nMasukan Elevasi datum: "))
(setq datumelev (atof stdatumelev))
;bikin garis
(while
(setq pt1 (getpoint "\nstart point: "))
(Setq Tgrs (* SkalaEL 0.002))
(Setq Pgrs (* SkalaEL 0.015))
(setq width1 (* SkalaEL 0.003))
(setq pt2 (LIST (CAR pt1) (+ (CAdR pt1) Tgrs) 0))
(setq pt3 (LIST (+ (CAR pt1) Pgrs) (+ (CAdR pt1) Tgrs) 0))
(setq splvl (list
(cons 0 "LWPOLYLINE")
(cons 8 "ELV_MARK")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 90 3)
(cons 10 PT1)
(cons 40 0.0)
(cons 41 width1)
(cons 10 PT2)
(cons 40 0.0)
(cons 41 0.0)
(cons 10 PT3)
(cons 40 0.0)
(cons 41 0.0)
)
)
(entmake splvl)
;bikin text
(defun Alpha2Number (Str$ / Num#)
(if (= 0 (setq Num# (strlen Str$)))
0
(+ (* (- (ascii (strcase (substr Str$ 1 1))) 64)
(expt 26 (1- Num#))
)
(Alpha2Number (substr Str$ 2))
) ;+
) ;if
)
(Setq XTptx (* SkalaEL 0.0025))
(Setq YTptx (* SkalaEL 0.015))
(Setq HTptx (* SkalaEL 0.0018))
(setq datumel (- datumelev (CAdR datumpoint)))
(setq postext10 (LIST (+ (CAR pt1) YTptx) (+ (CAdR pt1) XTptx) 0))
(setq postext11 (LIST (CAR pt1) (+ (CAdR pt1) YTptx) 0))
(setq elvtext2 (rtos (+ (CAdR pt1) datumel) 2 3))
(setq elvtextnum (Alpha2Number elvtext2))
(setq elvtext
(cond
((= elvtextnum -7639232) (strcat "EL. %%p" elvtext2))
((and (< elvtextnum -7639231)(> elvtextnum -233385375)) (strcat "EL. " elvtext2))
((> elvtextnum -233385376) (strcat "EL. +" elvtext2))
)
)
(setq TXELV
(entmake
(mapcar 'cons
(list 0 7 8 10 11 40 41 72 73 1)
(list "Text" "ELV_MARK" "ELV_MARK" postext11
postext10 HTptx 0.8 2
0 elvtext
)
)
)
)
)
(entmake
(mapcar 'cons
(list 0 62)
(list "SEQEND" 256)
)
)
(princ "\nn.pranyoto@gmail.com")
(princ)
)
