TUTORIAL | TIPS DAN TRIK

"Biasakan meng-copy Program LiSP tanpa menghapus nama penciptanya"

;n.pranyoto@gmail.com 060214 membuat lambang BREAKLINE DAN MELAKUKAN TRIM;
;------------------------------------------------
;------------------------------------------------
(defun C:BRKL (/ dtr #dwgscale old_cmd pt1
pt2 ang_rad pt_mid pt_mid1 pt_mid2
pt_mid_r pt_mid_l
)
(command "-linetype" "load" "dashdot" "acad.lin" "" "")

(defun dtr (angg)
(* pi (/ angg 180.0))
)
(setq #dwgscale (getint "\nMasukan skala gambar 1: "))
(setq old_cmd (getvar "CMDECHO"))
(setvar "CMDECHO" 0)
(command "_UNDO" "_BE")

(initget 1)
(setq pt1 (getpoint "\nBreakline start point: "))
(initget 1)
(setq pt2 (getpoint pt1 "\nBreakline end point: "))

(setq pt1 (trans pt1 1 0)
pt2 (trans pt2 1 0)
)


(setq ang_rad (angle pt1 pt2))
(setq pt_mid (polar pt1 ang_rad (/ (distance pt1 pt2) 2)))
(setq
pt_mid1 (polar pt1
ang_rad
(- (/ (distance pt1 pt2) 2) (* 0.001 #dwgscale))
)
)
(setq
pt_mid2 (polar pt1
ang_rad
(+ (/ (distance pt1 pt2) 2) (* 0.001 #dwgscale))
)
)
(setq
pt_mid_r (polar pt_mid (- ang_rad (dtr 105)) (* 0.002 #dwgscale))
)
(setq
pt_mid_l (polar pt_mid (+ ang_rad (dtr 75)) (* 0.002 #dwgscale))
)


(setq elist
(list
'(0 . "LWPOLYLINE")
;(5 . "57")
'(100 . "AcDbEntity")
;(67 . 0)
; '(8 . "SIZE") ;_ ????
'(100 . "AcDbPolyline")
'(6 . "dashdot")
'(90 . 6) ;_ ?????????? ??????
;(70 . 0)
;(43 . 0.0)
;(38 . 0.0)
;(39 . 0.0)
(cons 10
(polar pt1 (- ang_rad (dtr 180)) (* 0.00197 #dwgscale))
)
;(40 . 0.0)
;(41 . 0.0)
;(42 . 0.0)
(cons 10 pt_mid1)
(cons 10 pt_mid_r)
(cons 10 pt_mid_l)
(cons 10 pt_mid2)
(cons 10 (polar pt2 ang_rad (* 0.00197 #dwgscale)))
;(40 . 0.0)
;(41 . 0.0)
;(42 . 0.0)
;(210 0.0 0.0 1.0) )
)
)

(entmake elist)
(command "_UNDO" "_E")


(if olderr
(setq *error* olderr)
)
(setvar "CMDECHO" old_cmd)
(command "trim" "last" "")
(princ "\nn.pranyoto@gmail.com")
(princ)
)

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

)

Dalam menggunakan Autocad, kita tidak terpisahkan dengan layer.
akan tetapi membuat layer baru secara manual sangat membosankan dan memakan waktu..
untuk itulah saya menulis Lisp atau lsp untuk membuat layer baru.

"Biasakan meng-copy Program LiSP tanpa menghapus nama penciptanya"

LiSP Untuk membuat Layer baru

;n.pranyoto@gmail.com 280114 membuat layer baru;
;------------------------------------------------
(defun c:nl ()
(vl-load-com)
  (setq layername (getstring T "\nMasukan nama layer baru: "))
  (setq layercolorp
(getstring "\nMasukan warna layer baru: <7>")
 )
 (setq layercolor
(if
  (= layercolorp "") "7" layercolorp
)
 )
  (setq layerltypep
(getstring T "\nMasukan Ltype layer baru:
Continuous HIDDEN CENTER DASHDOT AND OTHER
<Continuous>"
)
  )
  (setq layerltype
(if
  (= layerltypep "") "Continuous" layerltypep
)
 )

  (if (not (tblsearch "LTYPE" layerltype))
; Check to see if linetype exsists
    (if (findfile "acad.lin")
      (command "-Linetype" "Load" layerltype "acad.lin" "")
; if linetype does found
      (setq layerltype "Continuous")
;if not set linetype to Continuous
    )
  )
  (setq layerLweightp
(getstring "\nMasukan Lweight layer baru
0.05 0.09 0.13 0.18 0.2 0.25
0.30 0.35 0.40 0.50 0.53 0.60
0.70 0.80 0.90 1.00 1.06
: <Default>")
 )
  (setq layerLweightitof (atof layerLweightp))
  (setq layerLweightx (* layerLweightitof 100))


  (setq layerLweight
(if
  (= layerLweightp "") -3 layerLweightx
)
 )
   (setq LayerName
       (vl-catch-all-apply
           'vla-add
           (list
               (vla-get-layers
                   (vla-get-activedocument
                       (vlax-get-acad-object)
                   )
               )
               Layername
           )
       )
   )
   (if (vl-catch-all-error-p LayerName)
       nil
       LayerName
   )
  (vla-put-color layername layercolor)
  (vla-put-linetype layername layerltype)
  (vla-put-LineWeight layername layerLweight)
  (vla-put-activelayer
    (vla-get-activedocument
      (vlax-get-acad-object)
    )
    LayerName
  )
(princ "\nn.pranyoto@gmail.com")
(princ)
)