LiSP Untuk membuat Layer baru

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


Untuk berlangganan
Masukan alamat email anda:

Delivered by FeedBurner

Posting Komentar