BREAKLINE DAN MELAKUKAN TRIM AUTOCAD LiSP

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

Untuk berlangganan
Masukan alamat email anda:

Delivered by FeedBurner

Posting Komentar