Ironpat.lsp

[Ironpat.lsp]

Hi i find this code in this site https://www.cadviet.com/forum/topic/13203-viết-lisp-theo-yêu-cầu-phần-2/?page=68. The project started by phamngoctukts . Is any one finish this code? Can any one help?

Thanks

 

 

(DEFUN stretchblock()
(batdau)  
 (princ "chon doi tuong: ")
 (setq ss0 (ssget))
 (initget 1)
 (setq hs (getreal "Cho biet he so STRETCH: "))
 (setq P01 (getpoint "\nChon diem chen: "))
(delblock)
 (command "-Block" "vkc_temp1" "0,0" ss0 "")
 (command "-insert" "vkc_temp1" "0,0" "" "" "")
 (setq sstt1 (entlast))
 (setq sstt (ssget "l"))
(blockrectang)
 (setq re1 (entlast))
 (setq tt (entget re1)) 
 (setq tt (vl-remove-if '(lambda (x) (/= 10 (car x))) tt)) 
 (setq dinh1 (cdr (nth 0 tt)))
 (setq dinh2 (cdr (nth 1 tt)))
 (command "_.erase" "l" "")
 (command "_.copy" sstt1 "" "0,0" "0,0")
 (command "_.explode" "l")
 (setq ss00 (ssget "p"))
 (Command "_.Explode" sstt1)
 (command "-Block" "vkc_temp1" "y" dinh1 ss00 "")
 (command "line" dinh2 dinh1 "")
 (setq re (ssget "l"))
 (command "_.move" re "" dinh1 p01)
 (command "_.rotate" re "" p01 "45")
 (command "-insert" "vkc_temp1" "r" "45" p01 "" "")
 (setq blgoc (entlast))
 (Command "Explode" blgoc)
 (setq bl (ssget "p")) 
 (command "-Block" "vkc_temp2" P01 re "")
 (command "-Block" "vkc_temp3" P01 bl "")
 (Command "-Insert" "vkc_temp3" P01 "" hs "")  
 (setq dt1 (entlast))
 (Command "-Insert" "vkc_temp2" P01 "" hs "")  
 (Command "_.Explode" "l" "")
 (setq dt2 (entlast))
 (setq tt1 (entget dt2))
 (setq tt1 (vl-remove-if '(lambda (x) (/= 10 (car x))) tt1))
 (setq dinh11 (cdr (nth 0 tt1)))
 (command "_.align" dt1 "" p01 dinh1 dinh11 dinh2 "" "y")
 (command "_.erase" dt2 "")
 (command "_.move" dt1 "" dinh1 p01)
 (Command "_.Explode" "l")
(ketthuc)
 (princ)
)
;**************************************************************
(defun c:stb ()
(stretchblock)
)

(defun batdau ()
 (command "undo" "be")
 (setvar "cmdecho" 0)
 (while (/= (logand (getvar "cmdactive") 31) 0)(command pause))
)
;**************************************************************
(defun ketthuc ()
 (command "undo" "e")
 (setvar "cmdecho" 1)
)
;**************************************************************
(defun delblock ()
(Command "-Purge" "B" "vkc_temp1" "Y" "Y")
(Command "-Purge" "B" "vkc_temp2" "Y" "Y")
(Command "-Purge" "B" "vkc_temp3" "Y" "Y")
)
;**************************************************************       
(defun blockrectang ()
(while (setq e (ssname sstt 0))
(setq sstt (ssdel e sstt)
tmp (vla-getboundingbox (vlax-ename->vla-object e) 'p1 'p3)
p1 (vlax-safearray->list p1)
p3 (vlax-safearray->list p3) 
p1 (list (car p1) (cadr p1))
p3 (list (car p3) (cadr p3))
p2 (list (car p1) (cadr p3))
p4 (list (car p3) (cadr p1))
tmp (list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity") 
(cons 100 "AcDbPolyline") 
(cons 90 4)
(cons 70 1)
(cons 10 p1)
(cons 10 p2)
(cons 10 p3)
(cons 10 p4)
)
)
(entmake tmp)
) 
)