Ứng dụng LISP để vẽ bản vẽ kiến trúc (phần cơ bản)

[be_chanh 894]

Một bản vẽ mới được thiết lập. Vẫn những layer đó, vẫn những kiểu text đó, vẫn những kiểu dim đó...Bạn không cần thiết phải làm lại từ đầu vì quá mất thời gian. Vậy làm thế nào???

 

( Tất cả các LISP CODE bạn chỉ việc copy rồi save ra file cùng tên với lệnh lisp và có phần mở rộng la .LSP (ví dụ: TaoL.LSP) là ok :lol: )

 

Bài 1: Tạo Layer

 

(defun c:TaoL()  (command "layer" "m" "!tuong" "c" "2" "" "")  (command "layer" "m" "!tim" "c" "1" "" "")  (command "layer" "m" "!thay" "c" "7" "" "")  (command "layer" "m" "!noithat" "c" "8" "" "")  (command "layer" "m" "!hatch" "c" "8" "" "")  (command "layer" "m" "!chu" "c" "3" "" "")  (command "layer" "m" "!kichthuoc" "c" "8" "" "")  (princ)  )

Với lisp này lệnh để tạo layer sẽ là TaoL.

 

Bài 2: Tạo Text Style ( kiểu chữ )

 

(defun c:TaoC()  (command "style" "!vnAvanH" ".VnAvantH" "" "" "" "" "")  (princ))

Với lisp này lệnh để tạo kiểu chữ sẽ là TaoC.

 

Bài 3: Tạo Dim Style ( kiểu kích thước )

 

(defun c:TaoK (/ scl fcal scal );dmasz dexo dexo dtxt dgap dclre dclrt dsn ao ad obj)(vl-load-com)(setq scl (getstring "\nTY LE BAN VE: "))(setq fcal (atof (substr scl 1 1))) (setq scal (atof (substr scl 3 3))) (setq tyle (/ fcal scal))  (setq caochu (getint "\nCHIEU CAO CUA CHU: "))(setvar "DIMALTF" 25)(setvar "DIMALTTZ" 13) (setvar "DIMALTZ" 13) (setvar "DIMBLK" "ArchTick") (setvar "DIMBLK1" "ArchTick")(setvar "DIMBLK2" "ArchTick")(setvar "DIMASZ" (/ caochu 2))(setvar "DIMCEN" -50)  (setvar "DIMCLRD" 9)(setvar "DIMDLE" (/ caochu 2))(setvar "DIMTOFL" 1)(setvar "DIMDLI" 0)(setvar "DIMCLRE" 9)(setvar "DIMEXE" (/ caochu 2))(setvar "DIMEXO" 0)(setvar "DIMTMOVE" 2)(setvar "DIMLDRBLK" "ArchTick")(setvar "DIMDEC" 0)(setvar "DIMCLRT" 9)(setvar "DIMTXT" caochu)(setvar "DIMLFAC" TYLE) (setvar "DIMTIX" 1)(setvar "DIMTIH" 0)(setvar "DIMGAP" (/ caochu 2))(setvar "DIMTOH" 0)(setvar "DIMTAD" 1)(setvar "DIMTXSTY" "!vnAvanH")(setvar "DIMTDEC" 0)(setvar "DIMTZIN" 13)(setvar "DIMZIN" 13);-------------------------------------------------------------(setq dsn (getstring "\nTEN CUA KIEU DIM MOI: ")) (setq ao (vlax-get-acad-object)) (setq ad (vla-get-ActiveDocument ao)) (setq obj (vla-add (vla-get-dimstyles ad) dsn)) (vla-copyfrom Obj ad) (vla-put-activedimstyle ad Obj) (princ) )

Với lisp này lệnh để tạo kiểu kích thước sẽ là TaoK.

Các thông số cần nhập

1. Tỷ lệ bản vẽ: (Thường là 1/1, cũng có thể là 1/2 tùy vào kiểu dim bạn muốn tạo)

2. Chiều cao chữ: (Tùy thuộc vào bản vẽ của bạn)

3. Tên kiểu dim mới: (Nên đặt theo chiều cao của chữ)

[be_chanh 894]

Xong phần khởi động. Giờ là bắt đấu vẽ với LINE, với ARC...

- Ồ! những đường Line này sao không phải là PLINE nhỉ? Vừa dễ quản lý vừa nhẹ bản vẽ. Phải làm sao đây? BO lại à ? OH không !!!

 

Bài 4. Nối LINE và ARC thành PLINE

 

(defun c:nn (/ tdt ssdt sodt index)(defun ObjName (ssdt /)(cdr (assoc '0 (entget ssdt))))(defun MoPL (ssdt /)(= (cdr (assoc '70 (entget ssdt))) 0))(defun NoiPL (ssdt /)(if (MoPL ssdt)(command ".PEDIT" ssdt "J" "All" "" "X")))(defun NoiLC (ssdt /)(command ".PEDIT" ssdt "Y" "J" "All" "" "X"))(setqtdt (ssget)sodt (sslength tdt)index 0)(repeat sodt(setqssdt (ssname tdt index)index (1+ index))(if (or (= (Objname ssdt) "LWPOLYLINE")(= (Objname ssdt) "POLYLINE"))(NoiPL ssdt))(if (or (= (Objname ssdt) "LINE") (= (Objname ssdt) "ARC"))(NoiLC ssdt)))(princ))

Lệnh để nối LINE và ARC thành PLINE là nn

[be_chanh 894]

Nhanh quá! Cái lisp NN kia giúp tôi đỡ được bao nhiêu công khi phải BO line thanh PLINE.

 

Giờ đến vễ cửa, cửa đi, cửa sổ... nhiều quá. Copy từ thư viện ra thì lại phải SCALE rồi làng nhằng LAYER không đúng với bản vẽ của mình ! Vậy thì co cách nào không nhỉ?

 

Bài 5: Vẽ cửa đi

 

;-------------------------------------------------------------------------------------;ve cua di 1 canh;-------------------------------------------------------------------------------------(defun c:c1 (/ p1 p2 p3 p4 p5 daicua x y)(setq osm (getvar "osmode"))  (setq	p1     (getpoint "\nHay vao diem goc cua: ")	p2     (getpoint p1 "\nHay vao diem mut cua: ")	p3     (getpoint p1 "\nHay vao huong cua: ")	daicua (distance p1 p2)	x      (car p1)	y      (car (cdr p1))	x      25	y      daicua	p4     (list x y)	p5     (list daicua 0)  )  (setvar "OSMODE" 0)  (if (l3d_khongthanghang p1 p2 p3)    (progn      (command ".UCS" "3" p1 p2 p3)      (command ".rectangle" "0,0" p4)      (command ".Arc" p5 "C" "0,0" p4)      (command ".UCS" "P")    )    (princ "\n3 diem nhap vao khong duoc thang hang")  )(setvar "osmode" osm)       );-------------------------------------------------------------------------------------;ve cua di 2 canh;-------------------------------------------------------------------------------------(defun c:c2 (/ p1 p2 p3 p4 p5 daicua x y)  (setq osm (getvar "osmode"))    (setq	p1     (getpoint "\nHay vao diem goc cua: ")	p2     (getpoint p1 "\nHay vao diem mut cua: ")	p3     (getpoint p1 "\nHay vao huong cua: ")	daicua (/ (distance p1 p2) 2.0)	x      (car p1)	y      (car (cdr p1))	x      25	y      daicua 	p4     (list x y)	p5     (list daicua 0)  )  (setvar "OSMODE" 0)  (if (l3d_khongthanghang p1 p2 p3)    (progn      (command ".UCS" "3" p1 p2 p3)      (command ".rectangle" "0,0" p4)      (command ".Arc" p5 "C" "0,0" p4)      (command ".UCS" "P")            (command ".UCS" "3" p2 p1 p3)      (command ".rectangle" "0,0" p4)      (command ".Arc" p5 "C" "0,0" p4)      (command ".UCS" "P")          )    (princ "\n3 diem nhap vao khong duoc thang hang")  )  (setvar "osmode" osm)       );-------------------------------------------------------------------------------------;ve cua di 4 canh;-------------------------------------------------------------------------------------(defun c:c4 (/ p1 p2 p3 p4 p5 daicua x y)  (setq osm (getvar "osmode"))      (setq	p1     (getpoint "\nHay vao diem goc cua: ")	p2     (getpoint p1 "\nHay vao diem mut cua: ")	p3     (getpoint p1 "\nHay vao huong cua: ")	daicua (/ (distance p1 p2) 4.0)	x      (car p1)	y      (car (cdr p1))	x      25	y      daicua 	p4     (list x y)	p5     (list daicua 0)  )  (setvar "OSMODE" 0)  (if (l3d_khongthanghang p1 p2 p3)    (progn            (setq diem1 (diemgiua p1 (diemgiua p1 p2)))      (setq diem2 (diemgiua p1 p2))      (setq diem3 (diemgiua p2 (diemgiua p1 p2)))      	      (command ".UCS" "3" p1 p2 p3)      (command ".rectangle" "0,0" p4)      (command ".Arc" p5 "C" "0,0" p4)      (command ".UCS" "P")            (command ".UCS" "3" diem1 p2 p3)      (command ".rectangle" "0,0" p4)      (command ".Arc" p5 "C" "0,0" p4)           (command ".UCS" "P")                  (command ".UCS" "3" p2 p1 p3)      (command ".rectangle" "0,0" p4)      (command ".Arc" p5 "C" "0,0" p4)      (command ".UCS" "P")      (command ".UCS" "3" diem3 p1 p3)      (command ".rectangle" "0,0" p4)      (command ".Arc" p5 "C" "0,0" p4)      (command ".UCS" "P")          )    (princ "\n3 diem nhap vao khong duoc thang hang")  )(setvar "osmode" osm)         );-----------------------------------------------------------------------------

Có 3 lệnh trong lisp này.

c1: vẽ cửa đi 1 cánh

c2: vẽ cửa đi 2 cánh

c4: vẽ cửa đi 4 cánh

 

Thế còn cửa sổ thì sao nhỉ ?

 

Bài 6: Vẽ cửa sổ

 

(defun c:w1(/ data_m l1 l2 p1 p2 check)(defun wd_import(/ p3 p4 p5 p6)    (setq data_m (ssget))    (setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :"))    (setq l1 nil l2 nil check 1)    (if (not (= nil data_m)) (progn        (setq l1 (entget (ssname data_m 0)))        (setq l2 (entget (ssname data_m 1)))        (if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0))        (if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0))        (if (not (= 0 (-(sslength data_m) 2))) (setq check 0))        (if (= 1 check) (progn            (setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3)))            (setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4)))            (setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5)))            (setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6)))            (if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0))        ))    ) (setq check 0))    (princ))(defun wd_procced()(defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)    (setq p3 (cdr (assoc 10 l1)))     (setq p4 (cdr (assoc 11 l1)))     (setq p5 (cdr (assoc 10 l2)))     (setq p6 (cdr (assoc 11 l2)))     (if (> (abs (- (nth 1 p1) (nth 1 p3)))           (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))    (if (> (abs (- (nth 1 p1) (nth 1 p4)))           (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))    (if (> (abs (- (nth 1 p2) (nth 1 p5)))           (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))    (if (> (abs (- (nth 1 p2) (nth 1 p6)))           (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))    (if (= 0 check) (princ "\ninvalid data") (progn        (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) )));        (princ ls1)        (setq p7 (list (nth 0 p3) (nth 0 ls1) 0))        (setq p8 (list (nth 0 p3) (nth 1 ls1) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))        (setq p8 (list (nth 0 p3) (nth 3 ls1) 0))        (mkline p7 p8 l1)        (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) )));        (princ ls1)        (setq p7 (list (nth 0 p5) (nth 0 ls1) 0))        (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 0 p5) (nth 2 ls1) 0))        (setq p8 (list (nth 0 p5) (nth 3 ls1) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 0 p3) (nth 1 ls1) 0))        (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))        (setq p8 (list (nth 0 p5) (nth 2 ls1) 0))        (mkline p7 p8 l1)        (setq getom (getvar "osmode"))        (setvar "osmode" 0)        (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5))))        (setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))        (setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))        (setq ll1 (list            (cons 0 "line")            (cons 8 (getvar "clayer"))        ))                (drawrt2 p7 p8 ll1)        (setvar "osmode" getom)        (command "erase" data_m "")    ))    (princ))(defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)    (setq p3 (cdr (assoc 10 l1)))     (setq p4 (cdr (assoc 11 l1)))     (setq p5 (cdr (assoc 10 l2)))     (setq p6 (cdr (assoc 11 l2)))     (if (> (abs (- (nth 0 p1) (nth 0 p3)))           (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))    (if (> (abs (- (nth 0 p1) (nth 0 p4)))           (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))    (if (> (abs (- (nth 0 p2) (nth 0 p5)))           (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))    (if (> (abs (- (nth 0 p2) (nth 0 p6)))           (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))    (if (= 0 check) (princ "\ninvalid data") (progn                (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) )));        (princ ls1)        (setq p7 (list (nth 0 ls1) (nth 1 p3) 0))        (setq p8 (list (nth 1 ls1) (nth 1 p3) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))        (setq p8 (list (nth 3 ls1) (nth 1 p3) 0))        (mkline p7 p8 l1)        (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) )));        (princ ls1)        (setq p7 (list (nth 0 ls1) (nth 1 p5) 0))        (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 2 ls1) (nth 1 p5) 0))        (setq p8 (list (nth 3 ls1) (nth 1 p5) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 1 ls1) (nth 1 p3) 0))        (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))        (setq p8 (list (nth 2 ls1) (nth 1 p5) 0))        (mkline p7 p8 l1)        (setq getom (getvar "osmode"))        (setvar "osmode" 0)        (setq ls2 (arlst (list (nth 1 p3) (nth 1 p5))))        (setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))        (setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))        (setq ll1 (list            (cons 0 "line")            (cons 8 (getvar "clayer"))        ))        (drawrt3 p7 p8 ll1)        (setvar "osmode" getom)        (command "erase" data_m "")    ))    (princ))    (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1)    (if (= 0 check) (princ "\ninvalid data") (progn        (if (< (abs (- (nth 0 (cdr (assoc 10 l1)))                       (nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv))        (if (< (abs (- (nth 1 (cdr (assoc 10 l1)))                       (nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh))            ))        (princ)    )    (wd_import)  	(ai_undo_push)    (wd_procced)  	(ai_undo_pop)	)(defun c:w2(/ data_m l1 l2 p1 p2 check)(defun wd_import(/ p3 p4 p5 p6)    (setq data_m (ssget))    (setq p1 (getpoint "\nfirst point :") p2 (getpoint "\nsecond point :"))    (setq l1 nil l2 nil check 1)    (if (not (= nil data_m)) (progn        (setq l1 (entget (ssname data_m 0)))        (setq l2 (entget (ssname data_m 1)))        (if (or (= nil l1) (not (= "LINE" (cdr (assoc 0 l1))))) (setq check 0))        (if (or (= nil l2) (not (= "LINE" (cdr (assoc 0 l2))))) (setq check 0))        (if (not (= 0 (-(sslength data_m) 2))) (setq check 0))        (if (= 1 check) (progn            (setq p3 (cdr (assoc 10 l1))) (setq p3 (list (nth 0 p3) (nth 1 p3)))            (setq p4 (cdr (assoc 11 l1))) (setq p4 (list (nth 0 p4) (nth 1 p4)))            (setq p5 (cdr (assoc 10 l2))) (setq p5 (list (nth 0 p5) (nth 1 p5)))            (setq p6 (cdr (assoc 11 l2))) (setq p6 (list (nth 0 p6) (nth 1 p6)))            (if (not (= nil (inters p3 p4 p5 p6 nil))) (setq check 0))        ))    ) (setq check 0))    (princ))(defun wd_procced()(defun mkv(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)    (setq p3 (cdr (assoc 10 l1)))     (setq p4 (cdr (assoc 11 l1)))     (setq p5 (cdr (assoc 10 l2)))     (setq p6 (cdr (assoc 11 l2)))     (if (> (abs (- (nth 1 p1) (nth 1 p3)))           (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))    (if (> (abs (- (nth 1 p1) (nth 1 p4)))           (abs (- (nth 1 p3) (nth 1 p4))) ) (setq check 0))    (if (> (abs (- (nth 1 p2) (nth 1 p5)))           (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))    (if (> (abs (- (nth 1 p2) (nth 1 p6)))           (abs (- (nth 1 p5) (nth 1 p6))) ) (setq check 0))    (if (= 0 check) (princ "\ninvalid data") (progn        (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p3) (nth 1 p4) )));        (princ ls1)        (setq p7 (list (nth 0 p3) (nth 0 ls1) 0))        (setq p8 (list (nth 0 p3) (nth 1 ls1) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))        (setq p8 (list (nth 0 p3) (nth 3 ls1) 0))        (mkline p7 p8 l1)        (setq ls1 (arlst (list (nth 1 p1) (nth 1 p2) (nth 1 p5) (nth 1 p6) )));        (princ ls1)        (setq p7 (list (nth 0 p5) (nth 0 ls1) 0))        (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 0 p5) (nth 2 ls1) 0))        (setq p8 (list (nth 0 p5) (nth 3 ls1) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 0 p3) (nth 1 ls1) 0))        (setq p8 (list (nth 0 p5) (nth 1 ls1) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 0 p3) (nth 2 ls1) 0))        (setq p8 (list (nth 0 p5) (nth 2 ls1) 0))        (mkline p7 p8 l1)        (setq ls2 (arlst (list (nth 0 p3) (nth 0 p5))))                (setq ll1 (list            (cons 0 "line")            (cons 8 (getvar "clayer"))        ))				(if (< (nth 0 p1) (nth 0 ls2)) (progn        	(setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))			(setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))			(setq p7 (list (* (+ (nth 0 p7) (nth 0 p8)) 0.5) (nth 1 p7) 0))        	(drawrt2 p7 p8 ll1)			(setq p7 (list (- (nth 0 ls2) 70) (- (nth 1 ls1) 100) 0))			(setq p8 (list (- (nth 0 ls2) 70) (+ (nth 2 ls1) 100) 0))			(mkline p7 p8 ll1)			(setq p9 (list (+ (nth 0 p7) 70) (nth 1 p7) 0))			(mkline p7 p9 ll1)			(setq p9 (list (+ (nth 0 p8) 70) (nth 1 p8) 0))			(mkline p8 p9 ll1)	    )(progn		   	(setq p7 (list (nth 0 ls2) (nth 1 ls1) 0))			(setq p8 (list (nth 1 ls2) (nth 2 ls1) 0))			(setq p8 (list (* (+ (nth 0 p7) (nth 0 p8)) 0.5) (nth 1 p8) 0))        	(drawrt2 p7 p8 ll1)			(setq p7 (list (+ (nth 1 ls2) 70) (- (nth 1 ls1) 100) 0))			(setq p8 (list (+ (nth 1 ls2) 70) (+ (nth 2 ls1) 100) 0))			(mkline p7 p8 ll1)			(setq p9 (list (- (nth 0 p7) 70) (nth 1 p7) 0))			(mkline p7 p9 ll1)			(setq p9 (list (- (nth 0 p8) 70) (nth 1 p8) 0))			(mkline p8 p9 ll1)		))                (command "erase" data_m "")    ))    (princ))(defun mkh(/ p3 p4 p5 p6 p7 p8 p9 ls1 ls2 getom ll1)    (setq p3 (cdr (assoc 10 l1)))     (setq p4 (cdr (assoc 11 l1)))     (setq p5 (cdr (assoc 10 l2)))     (setq p6 (cdr (assoc 11 l2)))     (if (> (abs (- (nth 0 p1) (nth 0 p3)))           (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))    (if (> (abs (- (nth 0 p1) (nth 0 p4)))           (abs (- (nth 0 p3) (nth 0 p4))) ) (setq check 0))    (if (> (abs (- (nth 0 p2) (nth 0 p5)))           (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))    (if (> (abs (- (nth 0 p2) (nth 0 p6)))           (abs (- (nth 0 p5) (nth 0 p6))) ) (setq check 0))    (if (= 0 check) (princ "\ninvalid data") (progn                (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p3) (nth 0 p4) )));        (princ ls1)        (setq p7 (list (nth 0 ls1) (nth 1 p3) 0))        (setq p8 (list (nth 1 ls1) (nth 1 p3) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))        (setq p8 (list (nth 3 ls1) (nth 1 p3) 0))        (mkline p7 p8 l1)        (setq ls1 (arlst (list (nth 0 p1) (nth 0 p2) (nth 0 p5) (nth 0 p6) )));        (princ ls1)        (setq p7 (list (nth 0 ls1) (nth 1 p5) 0))        (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 2 ls1) (nth 1 p5) 0))        (setq p8 (list (nth 3 ls1) (nth 1 p5) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 1 ls1) (nth 1 p3) 0))        (setq p8 (list (nth 1 ls1) (nth 1 p5) 0))        (mkline p7 p8 l1)        (setq p7 (list (nth 2 ls1) (nth 1 p3) 0))        (setq p8 (list (nth 2 ls1) (nth 1 p5) 0))        (mkline p7 p8 l1)		(setq getom (getvar "osmode"))        (setvar "osmode" 0)				(setq ll1 (list	            (cons 0 "line")	            (cons 8 (getvar "clayer"))	        ))		(setq ls2 (arlst (list (nth 1 p3) (nth 1 p5))))		;(princ ls2)				(if (> (nth 1 p1) (nth 1 ls2)) (progn        	(setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))        	(setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))			(setq p8 (list (nth 2 ls1) (* (+ (nth 1 p7) (nth 1 p8)) 0.5) 0))		        	(drawrt3 p7 p8 ll1)			(setq p7 (list (- (nth 1 ls1) 100) (+ (nth 1 ls2) 70) 0))			(setq p8 (list (+ (nth 2 ls1) 100) (+ (nth 1 ls2) 70) 0))			(mkline p7 p8 ll1)			(setq p9 (list (nth 0 p7) (- (nth 1 p7) 70) 0))			(mkline p7 p9 ll1)			(setq p9 (list (nth 0 p8) (- (nth 1 p8) 70) 0))			(mkline p8 p9 ll1)		)(progn		  	(setq p7 (list (nth 1 ls1) (nth 0 ls2) 0))        	(setq p8 (list (nth 2 ls1) (nth 1 ls2) 0))			(setq p7 (list (nth 1 ls1) (* (+ (nth 1 p7) (nth 1 p8)) 0.5) 0))						(drawrt3 p7 p8 ll1)						(setq p7 (list (- (nth 1 ls1) 100) (- (nth 0 ls2) 70) 0))			(setq p8 (list (+ (nth 2 ls1) 100) (- (nth 0 ls2) 70) 0))			(mkline p7 p8 ll1)			(setq p9 (list (nth 0 p7) (+ (nth 1 p7) 70) 0))			(mkline p7 p9 ll1)			(setq p9 (list (nth 0 p8) (+ (nth 1 p8) 70) 0))			(mkline p8 p9 ll1)								))				(setvar "osmode" getom)	        (command "erase" data_m "")    ))    (princ))    (setvar "cmdecho" 0) (command "undo" "mark") (setvar "cmdecho" 1)    (if (= 0 check) (princ "\ninvalid data") (progn        (if (< (abs (- (nth 0 (cdr (assoc 10 l1)))                       (nth 0 (cdr (assoc 11 l1))) )) 0.00001) (mkv))        (if (< (abs (- (nth 1 (cdr (assoc 10 l1)))                       (nth 1 (cdr (assoc 11 l1))) )) 0.00001) (mkh))            ))        (princ)    )    (wd_import)    (wd_procced))

Có 2 lệnh trong lisp này.

w1: vẽ cửa sổ kiểu 1

w2: vẽ cửa sổ kiểu 2

[be_chanh 894]

Ờ nhỉ tí quến. Thế khi vẽ tim và tường thì làm thế nào cho nhanh. Co người thì dùng MLine, co người thì dùng Line. MLine thì không bàn, nhanh, nhưng không phải ai cũng quen. Vậy làm thế nào khi đã ve xong tim tường rồi? OFFSET ?

 

Bài 7: Offset line sang 2 bên

 

(defun c:oo(/ data_m)(defun import_data(/ i)    (setq data_m (ssget))    (if (= nil distan_m) (setq distan_m 110.0))    (princ "Distance (")    (princ distan_m)    (princ "):")    (setq i (getreal ))    (if (not (= nil i)) (setq distan_m i)))(defun process(/ ent check)(defun p_check()    (setq check 0)    (if (= "LINE" (cdr (assoc 0 ent))) (setq check 1))    (princ))(defun p_d_offset(/ p1 p2 p3 p4)(defun makeline(/ e2 e5);    (princ ent);    (setq e5 nil);    (setq e5 (cdr (assoc 5 ent)));    (princ e5);    (if (= nil e5) (setq e5 ))    (setq la (list (cons 0 "LINE")        (cons 5 (cdr (assoc 5 ent)) )        (cons 8 (cdr (assoc 8 ent)) )        (cons 10 p3)        (cons 11 p4)    ));    (princ la)    (entmake la)    (princ))    (setq p1 (cdr (assoc 10 ent)) p2 (cdr (assoc 11 ent)) )    (if (not (= p1 p2)) (progn        (if (< (abs (- (nth 0 p1) (nth 0 p2))) 0.000001) (progn            (setq p3 (list (+ (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )            (setq p4 (list (+ (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )            (makeline)            (setq p3 (list (- (nth 0 p1) distan_m) (nth 1 p1) (nth 2 p1) ) )            (setq p4 (list (- (nth 0 p2) distan_m) (nth 1 p2) (nth 2 p2) ) )            (makeline)        ))        (if (< (abs (- (nth 1 p1) (nth 1 p2))) 0.000001) (progn            (setq p3 (list (nth 0 p1) (+ (nth 1 p1) distan_m) (nth 2 p1) ) )            (setq p4 (list (nth 0 p2) (+ (nth 1 p2) distan_m) (nth 2 p2) ) )            (makeline)            (setq p3 (list (nth 0 p1) (- (nth 1 p1) distan_m) (nth 2 p1) ) )            (setq p4 (list (nth 0 p2) (- (nth 1 p2) distan_m) (nth 2 p2) ) )            (makeline)        ))    ))    (princ))    (if (not (= nil data_m)) (progn        (setq i 0)        (while (< i (sslength data_m)) (progn            (setq ent (entget (ssname data_m i)))            (p_check)            (if (= 1 check) (p_d_offset))            (setq i (+ i 1))        ))    ))    (princ))    (import_data)  	(ai_undo_push)    (process)  	(ai_undo_pop)    (princ))

Lênh để offset line sang 2 bên là oo.

....

Còn lắm nhưng mà ăn cơm đã..hè hè

[hau03k7 10]

Hay qúa,cám ơn Ji và cadviet nha..thật tuyêt..mình hiểu thêm về lisp

[be_chanh 894]

Bản vẽ cũng ổn rồi. chuẩn bị viết TEXT và Dim thôi. Nhưng trước khi chuyển sang phần mới. Tôi muốn cho cho các bạn biết thêm 2 mẹo nữa khi vẽ.

 

Bài 8: Break đối tượng

Nhiều người sẽ bảo có lệnh Break (br) rồi cần gì LISP. Nhưng không! Lệnh BR thường không chặt điểm mà chặt đoạn nếu ta không cẩn trọng.

 

(defun c:bf (/ dt diem)  (setq	dt   (car (entsel "\nVao doi tuong can chat")))  (if dt    (progn      (redraw dt 3)        (setq diem (getpoint "\nVao diem chat: "))      (redraw dt 4)    )  )    (if (and dt diem)        (command ".break" dt diem diem)  )  )

Lệnh bf sẽ giúp ta chặt đối tượng tại một điểm.

 

Bài 9: Nối 2 đường Line bị ngặt quãng

Hãy tưởng tượng bạn có 1 đương Line. Bạn Br nó. Đường Line giờ đã trở thành 2 đường riêng biệt, cách nhau 1 đoạn. Không cần thiết phải xoa 1 đường và EX đường kia khi bạn muốn 2 đường làm 1.

 

(defun c:jl (/ p1 p2 p3 ssdt entla entlb tt p1a p2a tt p1b p2b layermoi TAPLINEMOI TENLAYERMOI)  (defun thanghang (p0 p1 p2 / dx1 dy1 dx2 dy2 x1 y1 x2 y2 x0 y0)    (setq      x0  (car p0)      y0  (cadr p0)      x1  (car p1)      y1  (cadr p1)      x2  (car p2)      y2  (cadr p2)      dx1 (- x1 x0)      dy1 (- y1 y0)      dx2 (- x2 x0)      dy2 (- y2 y0)    )    (if	(equal (* dx1 dy2) (* dx2 dy1) 0.01)      t      nil    )  )  (defun noiline (p1 p2 p3 p4 / kq dmax)    (if	(and (thanghang p1 p2 p3) (thanghang p1 p2 p4))      (progn	(setq d1   (distance p1 p3)	      d2   (distance p1 p4)	      d3   (distance p2 p3)	      d4   (distance p2 p4)	      dmax (max d1 d2 d3 d4)	      kq   (cond		     ((= dmax d1) (list p1 p3))		     ((= dmax d2) (list p1 p4))		     ((= dmax d3) (list p2 p3))		     ((= dmax d4) (list p2 p4))		     (t nil)		   )	)	kq      )      nil    )  )  (init)  (setq    p1	  (getpoint "\ngocdau: ")    p2	  (getcorner p1 "\ngocsau: ")    ssdt  (ssget "c" p1 p2 '((0 . "LINE")))    entla (ssname ssdt 0)    entlb (ssname ssdt 1)    tt	  (entget entla)    p1a	  (cdr (assoc 10 tt))    p2a	  (cdr (assoc 11 tt))    tt	  (entget entlb)    p1b	  (cdr (assoc 10 tt))    p2b	  (cdr (assoc 11 tt))    tenlayermoi (cdr (assoc 8 (entget entla)))  )  (if (setq taplinemoi (noiline p1a p2a p1b p2b))    (progn      (command ".erase" ssdt "")      (entmake	(list	  (cons 0 "LINE")	  (cons 8 tenlayermoi)	  (cons 10 (car taplinemoi))	  (cons 11 (cadr taplinemoi))	)      )            (traos)    )    (princ "\nKhong the noi line duoc !")  )  (done))

Lệnh jl rất tiện. Bạn thử dùng mà xem...

 

Hẹn gặp lại vào bài sau "Những Lisp sử dụng để hoàn thiện bản vẽ". Chúc các bạn vui vẻ

[be_chanh 894]

Tiếp tục nào. Chán với mấy cái cửa, với mấy đường LINE rồi. Giờ ta Hatch nhé.

 

Bài 10: Hiệu chỉnh Hatch

 

(defun c:hc ()  	(setq elist	(entget (car (entsel "\nLUA CHON MAU HATCH DE SAO CHEP: ")))		etyp	(cdr (assoc 0 elist))		old 	(getvar "clayer")	);setq	(if (/= etyp "HATCH")		(prompt "\nKHONG PHAI DOI TUONG HATCH! HAY THU LAI!")		(progn			(setq layn (cdr (assoc 8 elist)))  			(setvar "HPNAME" (cdr (assoc 2 elist)))  			(setvar "HPSCALE" (cdr (assoc 41 elist)))  			(setvar "HPANG" (cdr (assoc 52 elist)))  			(setq pt1 (getpoint "\nCHON MOT DIEM TRONG VUNG SE HATCH: "))			(setvar "clayer" layn)  			(command "bhatch" pt1 "")			(setvar "clayer" old)		);progn	);if(princ));defun;****** mk ****** mk ****** mk ****** mk ****** mk ****** mk ******(defun c:hm ()  	(setq ename	(entsel "\nLUA CHON MAU HATCH DE DI CHUYEN: ")		elist (entget (car ename))		etyp	(cdr (assoc 0 elist))		old 	(getvar "clayer")	);setq	(if (/= etyp "HATCH")		(prompt "\nKHONG PHAI DOI TUONG HATCH! HAY THU LAI!")		(progn			(setq layn (cdr (assoc 8 elist)))  			(setvar "HPNAME" (cdr (assoc 2 elist)))  			(setvar "HPSCALE" (cdr (assoc 41 elist)))  			(setvar "HPANG" (cdr (assoc 52 elist)))  					        (setq pt1 (getpoint "\nCHON MOT DIEM TRONG VUNG SE HATCH: "))			(setvar "clayer" layn)			(entdel (car ename))  			(command "bhatch" pt1 "")			(setvar "clayer" old)		);progn	);if(princ));defun;****** mk ****** mk ****** mk ****** mk ****** mk ****** mk ******(defun c:ha		()  	(setq ename(entsel "\nLUA CHON MAU HATCH DE THAY DOI GOC : ")		elist(entget (car ename))		etyp(cdr (assoc 0 elist))		oang(assoc 52 elist)	);setq	(if (/= etyp "HATCH")		(prompt "\nKHONG PHAI DOI TUONG HATCH! HAY THU LAI!")		(progn		(setq ang  (getangle (strcat "\nSO DO GOC MOI <" (rtos (cdr oang) 2) ">:"))		nang (cons 52 ang)		nlst (subst nang oang elist)		)		(entmod nlst)		(command "hatchedit" ename "" "" "" "")		);progn	);if(princ));defun;****** mk ****** mk ****** mk ****** mk ****** mk ****** mk ******(defun c:hs		()  	(setq ename	(entsel "\nLUA CHON MAU HATCH DE THAY DOI TY LE : ")		elist (entget (car ename))		etyp	(cdr (assoc 0 elist))		oscl (assoc 41 elist)	);setq	(if (/= etyp "HATCH")		(prompt "\nKHONG PHAI DOI TUONG HATCH! HAY THU LAI!")		(progn		(setq hscl (getreal (strcat "\nTY LE MAU HATCH MOI <" (rtos (cdr oscl) 2) ">:"))					nscl (cons 41 hscl)					nlst (subst nscl oscl elist)			)		(entmod nlst)		(command "hatchedit" ename "" "" "" "")		);progn	);if(princ));defun

Trong lisp này cung cấp cho chúng ta những lện sau

1. hc: Copy Hatch

1. hm: Move Hatch

1. ha: Chỉnh góc của mấu Hatch

1. hs: Chỉnh độ Scale của mẫu Hatch

[be_chanh 894]

Bài 11: Hiệu chỉnh Text

AutoDesk cung cấp cho chúng ta một lisp rất hây, nhưng lại được ít người quan tâm, và đây !

 

; Next available MSG number is   83 ; MODULE_ID CHTEXT_LSP_;;;;;;    CHTEXT.lsp - change text;;;;;;    Copyright 1997 by Autodesk, Inc.;;;;;;    Permission to use, copy, modify, and distribute this software;;;    for any purpose and without fee is hereby granted, provided;;;    that the above copyright notice appears in all copies and;;;    that both that copyright notice and the limited warranty and;;;    restricted rights notice below appear in all supporting;;;    documentation.;;;;;;    AUTODESK PROVIDES THIS PROGRAM "AS IS" AND WITH ALL FAULTS.;;;    AUTODESK SPECIFICALLY DISCLAIMS ANY IMPLIED WARRANTY OF;;;    MERCHANTABILITY OR FITNESS FOR A PARTICULAR USE.  AUTODESK, INC.;;;    DOES NOT WARRANT THAT THE OPERATION OF THE PROGRAM WILL BE;;;    UNINTERRUPTED OR ERROR FREE.;;;;;;    Use, duplication, or disclosure by the U.S. Government is subject to;;;    restrictions set forth in FAR 52.227-19 (Commercial Computer;;;    Software - Restricted Rights) and DFAR 252.227-7013©(1)(ii) ;;;    (Rights in Technical Data and Computer Software), as applicable.;;;  ;;;--------------------------------------------------------------------------;;;; DESCRIPTION;;;   This is a "text processor" which operates in a global manner ;;;   on all of the text entities that the user selects; i.e., the;;;   Height, Justification, Location, Rotation, Style, Text, and;;;   Width can all be changed globally or individually, and the;;;   range of values for a given parameter can be listed.;;;   ;;;   The command is called with CHT from the command line at which;;;   time the user is asked to select the objects to change.;;;   ;;;     Select text to change. ;;;     Select objects:;;;  ;;;   If nothing is selected the message "ERROR: Nothing selected." ;;;   is displayed and the command is terminated.  If more than 25;;;   entities are selected the following message is displayed while;;;   the text entities are sorted out from the non-text entities.;;;   A count of the text entities found is then displayed.;;;   ;;;     Verifying the selected entities...;;;     nnn  text entities found.;;;     CHText:  Height/Justification/Location/Rotation/Style/Text/Undo/Width:;;;   ;;;   A typical example of the prompts you may encounter follows:;;;   ;;;   If you select a single text entity to change and ask to change;;;   the height, the prompt looks like this:;;;   ;;;     CHText:  Height/Justification/Location/Rotation/Style/Text/Undo/Width:;;;     New text height for text entity. <0.08750000>:;;;   ;;;   If you select more than one text entity to change and ask to change;;;   the height, the prompt looks like this:;;;   ;;;     CHText:  Height/Justification/Location/Rotation/Style/Text/Undo/Width:;;;     Individual/List/<New height for all entities>:;;;   ;;;   Typing "L" at this prompt returns a prompt showing you the range of;;;   values that you are using for your text.;;;   ;;;     Height -- Min: 0.05000000  Max: 0.10000000  Ave: 0.08392857;;;   ;;;   Typing "I" at this prompt puts you in a loop, processing the text;;;   entities you have selected one at a time, and giving the same prompt;;;   you get for a single text entity shown above.;;;   ;;;   Pressing ENTER at this point puts you back at the Command: prompt.;;;   Selecting any of the other options allows you to change the text;;;   entities selected. ;;;   ;;;---------------------------------------------------------------------------;(defun cht_Main ( / sset opt ssl nsset temp unctr ct_ver sslen style hgt rot                    txt ent loc loc1 just-idx justp justq orthom                    cht_ErrorHandler cht_OrgError cht_OrgCmdecho                    cht_OrgTexteval cht_OrgHighlight)  ;; Reset if changed  (setq ct_ver "2.00")  ;; Internal error handler defined locally  (defun cht_ErrorHandler (s)    (if (/= s "Function cancelled")      (if (= s "quit / exit abort")        (princ)        (princ (strcat "\nError: " s))      )    )    (eval (read U:E))    ;;  Reset original error handler if there    (if cht_OrgError (setq *error* cht_OrgError))    (if temp (redraw temp 1))    (ai_undo_off) ;; restore undo state    (if cht_OrgCmdecho (setvar "cmdecho" cht_OrgCmdecho))    (if cht_OrgTexteval (setvar "texteval" cht_OrgTexteval))     (if cht_OrgHighlight (setvar "highlight" cht_OrgHighlight))     (princ)  )  ;; Set error handler  (if *error*    (setq cht_OrgError *error*          *error* cht_ErrorHandler)    (setq *error* cht_ErrorHandler)   )  ;; Set undo groups and ends with (eval(read U:G)) or (eval(read U:E))  (setq U:G "(command \"_.undo\" \"_group\")"        U:E "(command \"_.undo\" \"_en\")"  )    (ai_undo_on)       ;; enable undo    (setq cht_OrgCmdecho (getvar "cmdecho"))  (setq cht_OrgHighlight (getvar "highlight"))   (setvar "cmdecho" 0)    (princ (strcat "\nChange text, Version "                 ct_ver                  ", Copyright © 1997 by Autodesk, Inc."))  (prompt "\nSelect annotation objects to change.")  (setq sset (ai_aselect))  (if (null sset)     (progn      (princ "\nNo objects selected.")      (exit)    )  )  ;; Validate selection set  (setq ssl   (sslength sset)        nsset (ssadd))  (if (> ssl 25)    (princ "\nVerifying selected objects...")  )  (while (> ssl 0)    (setq temp (ssname sset (setq ssl (1- ssl))))    (if (or          (= (cdr (assoc 0 (entget temp))) "TEXT")          (= (cdr (assoc 0 (entget temp))) "ATTDEF")          (= (cdr (assoc 0 (entget temp))) "MTEXT")        )      (ssadd temp nsset)    )  )  (setq ssl (sslength nsset)        sset nsset        unctr 0  )  (print ssl)  (princ "annotation objects found.")  ;; Main loop  (setq opt T)  (while (and opt (> ssl 0))    (setq unctr (1+ unctr))    (command "_.UNDO" "_GROUP")    (initget "Location Justification Style Height Rotation Width Text Undo")    (setq opt (getkword       "\nHeight/Justification/Location/Rotation/Style/Text/Undo/Width: "))    (if opt      (cond        ((= opt "Undo")          (cht_Undo)        )        ((= opt "Location")          (cht_Location)        )        ((= opt "Justification")          (cht_Justification)        )        ((= opt "Style")          (cht_Property "Style"    "New style name"      7) )        ((= opt "Height")          (cht_Property "Height"   "New height"         40) )        ((= opt "Rotation")          (cht_Property "Rotation" "New rotation angle" 50) )        ((= opt "Width")          (cht_Property "Width"    "New width factor"   41) )        ((= opt "Text")          (cht_Text)        )      )      (setq opt nil)    )    (command "_.UNDO" "_END")  )  ;; Restore  (if cht_OrgError (setq *error* cht_OrgError))  (eval (read U:E))  (ai_undo_off) ;; restore undo state  (if cht_OrgTexteval (setvar "texteval" cht_OrgTexteval))   (if cht_OrgHighlight (setvar "highlight" cht_OrgHighlight))   (if cht_OrgCmdecho (setvar "cmdecho" cht_OrgCmdecho))  (princ));;; Undo an entry(defun cht_Undo ()  (if (> unctr 1)    (progn      (command "_.UNDO" "_END")      (command "_.UNDO" "2")      (setq unctr (- unctr 2))    )    (progn      (princ "\nNothing to undo. ")      (setq unctr (- unctr 1))    )  ));;; Change the location of an entry(defun cht_Location ()  (setq sslen (sslength sset)        style ""        hgt   ""        rot   ""        txt   ""  )  (command "_.CHANGE" sset "" "")  (while (> sslen 0)    (setq ent (entget(ssname sset (setq sslen (1- sslen))))          opt (list (cadr (assoc 11 ent))                    (caddr (assoc 11 ent))                    (cadddr (assoc 11 ent)))    )    (prompt "\nNew text location: ")    (command pause)    (if (null loc)      (setq loc opt)    )    (command style hgt rot txt)  )  (command));;; Change the justification of an entry(defun cht_Justification ()  (initget "TL TC TR ML MC MR BL BC BR Align Center Fit Left Middle Right ?")  (setq sslen (sslength sset))  (setq justp (getkword "\nAlign/Fit/Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR/<?>: "))  (cond    ((= justp "Left")    (setq justp 0 justq 0 just-idx 4) )    ((= justp "Center")  (setq justp 1 justq 0 just-idx 5) )    ((= justp "Right")   (setq justp 2 justq 0 just-idx 6) )    ((= justp "Align")   (setq justp 3 justq 0 just-idx 1) )    ((= justp "Fit")     (setq justp 5 justq 0 just-idx 1) )    ((= justp "TL")      (setq justp 0 justq 3 just-idx 1) )    ((= justp "TC")      (setq justp 1 justq 3 just-idx 2) )    ((= justp "TR")      (setq justp 2 justq 3 just-idx 3) )    ((= justp "ML")      (setq justp 0 justq 2 just-idx 4) )    ((= justp "Middle")  (setq justp 4 justq 0 just-idx 5) )    ((= justp "MC")      (setq justp 1 justq 2 just-idx 5) )    ((= justp "MR")      (setq justp 2 justq 2 just-idx 6) )    ((= justp "BL")      (setq justp 0 justq 1 just-idx 7) )    ((= justp "BC")      (setq justp 1 justq 1 just-idx 8) )    ((= justp "BR")      (setq justp 2 justq 1 just-idx 9) )    ((= justp "?")       (setq justp nil)       )    (T                   (setq justp nil)       )  )     (if justp    (progn ;; Process them...      (while (> sslen 0)        (setq ent (entget (ssname sset (setq sslen (1- sslen)))))        (cond          ((= (cdr (assoc 0 ent)) "MTEXT")            (setq ent (subst (cons 71 just-idx) (assoc 71 ent) ent))          )          ((= (cdr (assoc 0 ent)) "TEXT")            (setq ent (subst (cons 72 justp) (assoc 72 ent) ent)                  opt (trans (list (cadr (assoc 11 ent))                                   (caddr (assoc 11 ent))                                   (cadddr (assoc 11 ent)))                              (cdr (assoc -1 ent)) ;; from ECS                             1)               ;; to current UCS            )            (setq ent (subst (cons 73 justq) (assoc 73 ent) ent))            (cond              ((or (= justp 3) (= justp 5))                (prompt "\nNew text alignment points: ")                (if (= (setq orthom (getvar "orthomode")) 1)                  (setvar "orthomode" 0)                )                (redraw (cdr (assoc -1 ent)) 3)                (initget 1)                (setq loc (getpoint))                (initget 1)                (setq loc1 (getpoint loc))                (redraw (cdr (assoc -1 ent)) 1)                (setvar "orthomode" orthom)                (setq ent (subst (cons 10 loc) (assoc 10 ent) ent))                (setq ent (subst (cons 11 loc1) (assoc 11 ent) ent))              )              ((or (/= justp 0) (/= justq 0))                (redraw (cdr (assoc -1 ent)) 3)                (prompt "\nNew text location: ")                (if (= (setq orthom (getvar "orthomode")) 1)                  (setvar "orthomode" 0)                )                (setq loc (getpoint opt))                (setvar "orthomode" orthom)                (redraw (cdr (assoc -1 ent)) 1)                (if (null loc)                  (setq loc opt)                  (setq loc (trans loc 1 (cdr (assoc -1 ent))))                )                (setq ent (subst (cons 11 loc) (assoc 11 ent) ent))              )            )          )        )        (entmod ent)      )    )    (progn	;; otherwise list options      (textpage)      (princ "\nAlignment options:\n")      (princ "\t  TL     TC      TR\n")      (princ "\t  ML     MC      MR\n")      (princ "\t  BL     BC      BR\n")      (princ "\t Left   Center  Right\n")      (princ "\tAlign   Middle  Fit\n")      (princ "\nPress ENTER to continue: ")      (grread)      (princ "\r                                                            ")      (graphscr)    )  )  (command));;; Change the text of an object(defun cht_Text ( / ans)  (setq sslen (sslength sset))  (initget "Globally Individually Retype")  (setq ans (getkword     "\nFind and replace text.  Individually/Retype/<Globally>:"))  (setq cht_OrgTexteval (getvar "texteval"))  (setvar "texteval" 1)  (cond     ((= ans "Individually")      (progn        (initget "Yes No")        (setq ans (getkword "\nEdit text in dialog? <Yes>:"))      )        (while (> sslen 0)        (redraw (setq sn (ssname sset (setq sslen (1- sslen)))) 3)        (setq ss (ssadd))        (ssadd (ssname sset sslen) ss)        (if (= ans "No")           (cht_Edit ss)          (command "_.DDEDIT" sn "")        )        (redraw sn 1)      )    )    ((= ans "Retype")      (while (> sslen 0)        (setq ent (entget (ssname sset (setq sslen (1- sslen)))))        (redraw (cdr (assoc -1 ent)) 3)        (prompt (strcat "\nOld text: " (cdr (assoc 1 ent))))        (setq nt (getstring  T "\nNew text: "))        (redraw (cdr (assoc -1 ent)) 1)        (if (> (strlen nt) 0)          (entmod (subst (cons 1 nt) (assoc 1 ent) ent))        )      )    )    (T      (cht_Edit sset)   ;; Change all    )  )  (setvar "texteval" cht_OrgTexteval));;; The old CHGTEXT command - rudimentary text editor(defun C:CHGTEXT () (cht_Edit nil))(defun cht_Edit (objs / last_o tot_o ent o_str n_str st s_temp                        n_slen o_slen si chf chm cont ans class)  ;; Select objects if running standalone  (if (null objs)    (setq objs (ssget))  )  (setq chm 0)  (if objs     (progn                   ;; If any objects selected      (if (= (type objs) 'ENAME)         (progn          (setq ent (entget objs))          (princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))        )        (if (= (sslength objs) 1)          (progn            (setq ent (entget (ssname objs 0)))            (princ (strcat "\nExisting string: " (cdr (assoc 1 ent))))          )        )      )      (setq o_str (getstring "\nMatch string   : " t))      (setq o_slen (strlen o_str))      (if (/= o_slen 0)        (progn          (setq n_str (getstring "\nNew string     : " t))          (setq n_slen (strlen n_str))          (setq last_o 0                 tot_o  (if (= (type objs) 'ENAME)                         1                         (sslength objs)                       )          )          ;; For each selected object...          (while (< last_o tot_o)            (setq class (cdr (assoc 0 (setq ent (entget (ssname objs last_o))))))            (if (or (= "TEXT" class)                    (= "MTEXT" class) )              (progn                (setq chf nil si 1)                (setq s_temp (cdr (assoc 1 ent)))                (while (= o_slen (strlen (setq st (substr s_temp si o_slen))))                  (if (= st o_str)                    (progn                      (setq s_temp (strcat                                      (if (> si 1)                                       (substr s_temp 1 (1- si))                                        ""                                     )                                     n_str                                     (substr s_temp (+ si o_slen))                                   )                      )                      (setq chf t)    ;; Found old string                      (setq si (+ si n_slen))                    )                    (setq si (1+ si))                  )                )                (if chf                   (progn              ;; Substitute new string for old                    ;; Modify the TEXT entity                    (entmod (subst (cons 1 s_temp) (assoc 1 ent) ent))                    (setq chm (1+ chm))                  )                )              )            )            (setq last_o (1+ last_o))          )        )        ;; else go on to the next line...      )    )  )  (if (/= (type objs) 'ENAME)    ;; Print total lines changed    (if (/= (sslength objs) 1)      (princ (strcat (rtos chm 2 0) " text lines changed."))    )  )  (terpri));;; Main procedure for manipulating text entities(defun cht_Property (typ prmpt fld / temp ow nw ent tw sty w hw lw                               sslen n sn ssl)  (if (= (sslength sset) 1)           ;; Special case if there is only                                      ;; one entity selected    ;; Process one entity.    (cht_ProcessOne)    ;; Else    (progn      ;; Set prompt string.      (cht_SetPrompt)      (if (= nw "List")        ;; Process List request.        (cht_ProcessList)        (if (= nw "Individual")          ;; Process Individual request.          (cht_ProcessIndividual)          (if (= nw "Select")            ;; Process Select request.            (cht_ProcessSelect)            ;; Else            (progn              (if (= typ "Rotation")                (setq nw (* (/ nw 180.0) pi))              )              (if (= (type nw) 'STR)                (if (not (tblsearch "style" nw))                  (progn                    (princ (strcat nw ": Style not found. "))                  )                  (cht_ProcessAll)                )                (cht_ProcessAll)              )            )          )        )      )    )  ));;; Change all of the entities in the selection set(defun cht_ProcessAll (/ hl temp)  (setq sslen (sslength sset))  (setq hl (getvar "highlight"))  (setvar "highlight" 0)  (while (> sslen 0)    (setq temp (ssname sset (setq sslen (1- sslen))))    (entmod (subst (cons fld nw)                   (assoc fld (setq ent (entget temp)))                   ent ) )  )  (setvar "highlight" hl));;; Change one text entity(defun cht_ProcessOne ()  (setq temp (ssname sset 0))  (setq ow (cdr (assoc fld (entget temp))))  (if (= opt "Rotation")    (setq ow (/ (* ow 180.0) pi))  )  (redraw (cdr (assoc -1 (entget temp))) 3)  (initget 0)  (if (= opt "Style")    (setq nw (getstring (strcat prmpt " <" ow ">: ")))    (setq nw (getreal (strcat prmpt " <" (rtos ow 2) ">: ")))  )  (if (or (= nw "") (= nw nil))    (setq nw ow)  )  (redraw (cdr (assoc -1 (entget temp))) 1)  (if (= opt "Rotation")    (setq nw (* (/ nw 180.0) pi))  )  (if (= opt "Style")    (if (null (tblsearch "style" nw))      (princ (strcat nw ": Style not found. "))      (entmod (subst (cons fld nw)                     (assoc fld (setq ent (entget temp)))                     ent              )      )    )    (entmod (subst (cons fld nw)                   (assoc fld (setq ent (entget temp)))                   ent            )    )  ));;; Set the prompt string(defun cht_SetPrompt ()  (if (= typ "Style")    (progn      (initget "Individual List New Select ")      (setq nw (getkword (strcat "\nIndividual/List/Select style/<"                                 prmpt                                 " for all text objects" ">: ")))      (if (or (= nw "") (= nw nil) (= nw "Enter"))        (setq nw (getstring (strcat prmpt                                    " for all text objects" ": ")))      )    )    (progn      (initget "List Individual" 1)      (setq nw (getreal (strcat "\nIndividual/List/<"                                 prmpt                                 " for all text objects" ">: ")))    )  ));;; Process List request(defun cht_ProcessList ()  (setq unctr (1- unctr))  (setq sslen (sslength sset))  (setq tw 0)  (while (> sslen 0)    (setq temp (ssname sset (setq sslen (1- sslen))))    (if (= typ "Style")      (progn        (if (= tw 0)          (setq tw (list (cdr (assoc fld (entget temp)))))          (progn            (setq sty (cdr (assoc fld (entget temp))))            (if (not (member sty tw))              (setq tw (append tw (list sty)))            )          )        )      )      (progn        (setq tw (+ tw (setq w (cdr (assoc fld (entget temp))))))        (if (= (sslength sset) (1+ sslen)) (setq lw w hw w))        (if (< hw w) (setq hw w))        (if (> lw w) (setq lw w))      )    )  )  (if (= typ "Rotation")    (setq tw (* (/ tw pi) 180.0)          lw (* (/ lw pi) 180.0)          hw (* (/ hw pi) 180.0))  )  (if (= typ "Style")    (progn      (princ (strcat "\n" typ "(s) -- "))      (princ tw)    )    (princ (strcat "\n" typ             " -- Min: " (rtos lw 2)             "\t Max: " (rtos hw 2)             "\t Avg: " (rtos (/ tw (sslength sset)) 2) ) )  ));;; Process Individual request(defun cht_ProcessIndividual ()  (setq sslen (sslength sset))  (while (> sslen 0)    (setq temp (ssname sset (setq sslen (1- sslen))))    (setq ow (cdr (assoc fld (entget temp))))    (if (= typ "Rotation")      (setq ow (/ (* ow 180.0) pi))    )    (initget 0)    (redraw (cdr (assoc -1 (entget temp))) 3)    (if (= typ "Style")      (progn        (setq nw (getstring (strcat "\n" prmpt " <" ow ">: ")))      )      (progn        (setq nw (getreal (strcat "\n" prmpt " <" (rtos ow 2) ">: ")))      )    )    (if (or (= nw "") (= nw nil))      (setq nw ow)    )    (if (= typ "Rotation")      (setq nw (* (/ nw 180.0) pi))    )    (entmod (subst (cons fld nw)                   (assoc fld (setq ent (entget temp)))                   ent            )    )    (redraw (cdr (assoc -1 (entget temp))) 1)  ));;; Process the Select option(defun cht_ProcessSelect ()  (princ "\nSearch for which Style name?  <*>: ")  (setq sn  (xstrcase (getstring))        n   -1        nsset (ssadd)        ssl (1- (sslength sset))        )  (if (or (= sn "*") (null sn) (= sn ""))    (setq nsset sset sn "*")    (while (and sn (< n ssl))      (setq temp (ssname sset (setq n (1+ n))))      (if (= (cdr (assoc 7 (entget temp))) sn)        (ssadd temp nsset)      )    )  )  (princ (strcat "\nStyle: " sn))  (print (setq ssl (sslength nsset)))  (princ "objects found."));;; Check to see if AI_UTILS is loaded, If not, try to find it,;;; and then try to load it.  If it can't be found or can't be;;; loaded, then abort the loading of this file immediately.(cond  ((and ai_dcl (listp ai_dcl)))		; it's already loaded.  ((not (findfile "ai_utils.lsp"))		; find it    (ai_abort "CHT" nil)  )  ((eq "failed" (load "ai_utils" "failed"))	; load it    (ai_abort "CHT" nil)  ));;; If we get this far, then AI_UTILS.LSP is loaded and it can;;; be assumed that all functions defined therein are available.;;; Next, check to see if ACADAPP.EXP has been xloaded, and abort;;; if the file can't be found or xloaded.  Note that AI_ACADAPP;;; does not abort the running application itself (so that it can;;; also be called from within the command without also stopping;;; an AutoCAD command currently in progress).(if (not (ai_acadapp)) (ai_abort "CHT" nil));;; The C: function definition(defun c:cht () (cht_Main))

Lệnh cht giúp ta rất nhiều khi hiệu chỉnh chữ, ví dụ như chiều cao, góc...ta chẳng cần phải vào bảng thuộc tính (Ctrl+1) để sửa nữa, mọi thứ đều dùng dòng lệnh, nhanh hơn gấp bội...

[be_chanh 894]

Thế đấy ! Giờ thì bản vẽ đã ổn thỏa. Chẳng còn gì để làm nữa. Nhưng với đống LISP kia thì sao nhỉ? Nhiều file *.LSP quá @_@. Làm gì?

 

Bài 12: Chuyển LSP sang VLX

Công cụ này thì cực hay. Vì từ hàng trăm file LSP ta có thể chuyển thành 1 file VLX, gọn, nhẹ, bảo mật cao hơn...

 

 

Các bước thực hiện.

 

Bước 1: Khởi động Cad, tại dòng Command nhập lệnh vlide.

 

 

Bước 2: Trong cửa sổ Visual Lisp for AutoCad, nhấn vào File/Make Application/New Application Wizard

 

 

Bước 3: Chọn Simple vầ nhấn Next

 

 

Bước 4: Lựa chọn đường dẫn (Application Location) và tên file (Application Name) Rồi nhấn Next

 

 

Bước 5: Nhấn vào nút Add, 1 cửa sổ chọn file hiện ra, select tất cả các file LSP, rồi nhấn Open

 

 

Bước 6: Các file LSP vừa lựa chọn được cập nhật và bảng danh sách, nhấn Next

 

 

Bước 7: Nhấn Finish để kết thúc.

 

 

Quá trình này kết thúc thành công bàng 1 thông báo hoàn thành

 

 

Ok. Giờ thì file VLX duy nhất đã được tạo ra, rất gọn, rất nhẹ và bảo mật cao hơn..0_0

 

Nếu bạn không muốn mất thời gian, có thể tải file vlxcoban.vlx tại đây:

 

http://thunglungden.org/cadviet/cad/lisp/v...an/vlxcoban.vlx

 

Kết thúc. Chúc các bạn thành công với bộ lisp cơ bản này. Hẹn gặp lại lần sau với một bộ lisp năng cao, phát huy hết các tính năng của CAD.

 

Chào thân ái ! :lol:

[nk169 0]

quá hay !nhưng lisp này giúp cho công việc của mình nhẹ nhàng và nhanh hơn gấp bội.nhất là các bài viết này gíup mình hiểu hơn về cad một công cụ mà mình dùng thường xuyên

[khimatro 2]

cái này hay thật mình rất kết con này, bây h thì chỉ cần 1 file duy nhất.Nhưng mình thắc mắc có thể lấy file *.LSP từ trong file *.VLX không? nếu có thể bạn bày cách luôn nhé :lol:

[be_chanh 894]

Khi đã convert sang VLX rồi tức là mã đã chuyển thành mã máy (kiểu file exe) nên không có cách nào chuyển trực tiệp được cả. Vẫn có cách chuyển nhưng không phải trực tiếp, mà những cách này thì phải dân IT mới làm được...

[trantrung78 0]

Bác Jikibo oi! sao mấy cái đoạn CODE mà bác post lên, tôi copy lại, tạo file lisp mới rồi Paste vô, load vào acad nhưng lại không sử sử dụng được bác oi! Lúc tôi paste vào trong notepad các đoạn lệnh không nhảy cách dòng như trong bài post của bác vậy có phải là sai không hả bác! nhờ bác chỉ giáo thêm với, cám ơn bác nhiều!

[be_chanh 894]

Đúng thật. Vừa thử copy và paste sang notepad thì nó không còn chĩnh xác về các dấu xuống dòng nữa. Nhưng không sao. Để tiện cho sử dụng Ji đã compile 2 VLX rồi. Dừng luôn file VLX đó cho nhẹ...ok

[hung303 5]

Cám ơn bác đã san sẻ cho AE đỡ cực nhọc :lol:

[phanhkissss 0]

Anh cho hỏi lúc chuyển file tu LSP sang VLX em ko select được tất cả các file SLP ma chỉ chọn được từng file một để chuyển đổi thôi.Em xai CAd 05

[vbao 80]

Anh cho hỏi lúc chuyển file tu LSP sang VLX em ko select được tất cả các file SLP ma chỉ chọn được từng file một để chuyển đổi thôi.Em xai CAd 05

 

 

tôi gặp phải lỗi này khi sử dụng file vẽ cửa sổ = second point :; error: bad argument type: lentityp nil

và file vẽ cửa đi = Hay vao huong cua: ; error: no function definition: L3D_KHONGTHANGHANG

xin hướng dẫn cách khắc phục

[Nguyen Hoanh 4.663]

Anh cho hỏi lúc chuyển file tu LSP sang VLX em ko select được tất cả các file SLP ma chỉ chọn được từng file một để chuyển đổi thôi.Em xai CAd 05

Cách bình thường là được nhiều file mà bạn!

Bạn có thể môt tả cách làm của bạn được không?

[be_chanh 894]

tôi gặp phải lỗi này khi sử dụng file vẽ cửa sổ = second point :; error: bad argument type: lentityp nil

và file vẽ cửa đi = Hay vao huong cua: ; error: no function definition: L3D_KHONGTHANGHANG

xin hướng dẫn cách khắc phục

 

Lỗi này là khi bạn dùng 1 trong 3 lisp vẽ cửa đi (c1,c2,c4). Khi bạn chọn hướng của cửa, bạn phải chọn vào 1 trong mặt vùng được ngăn cách bằng đường thẳng nối từ 2 điểu đầu và cuối (vừa pick).

[h1000740 6]

anh oi tôi copy doạn code này nhưng không thể chạy được vẻ cửa và cửa sổ

cả hai đoạn code trên đều báo lỗi là KHONGTHANGHANG

XIN ANH COI LAI VA CHI GIÙM TÔI NGHI DÂY LA PHẦN RẤT HAY VÀ TIỆN LỢI

[Nguyen Hoanh 4.663]

Bạn upload file lisp đấy lên được không?

[xaydung 12]

Sao lâu ra "phần nâng cao" thế các Pác ơi????

[tacke_kd 0]

Bác nén lại gửi cho mọi người Lisp đấy được không? Paste cứ bị lỗi thôi, chẳng biết làm cách nào....?

[ts088 4]

Pac Jikibo đã chỉ cách tạo các layer định sẵn bằng 1 lisp rồi, Pác chỉ em luôn cách đặt các thuộc tính cho layer với, vi du: layer "tim" em muốn nó là đường Center lun. Mong được chỉ giáo.

[binarch 1]

đúng code nầy chep zo dau zay ban