Viết Lisp theo yêu cầu

[LXD 12]

Chào Bác Hoành!

 

Em làm trên AutoCAD cũng lâu lâu rồi, nhưng mới biết đến mạng mẹo - đúng là hay thật.

 

Em làm về Bản đồ phục vụ công trình. Em vẽ đường Đồng mức (bằng PolyLine), và nhập Cao độ cho nó bẳng cách nhập thủ công vào Elevation. Bác có thể viết cho Em 1 Lisp để có thể nhập giá trị cao độ nhanh hơn không ạ? Em nghĩ là về thuật toán thì có thể viết được-chắc là phải viết nhiều lắm, và Em thì chẳng biết gì về Lisp cả. Mong nhận được sự giúp đỡ của Bác. Cảm ơn Bác trước.

[Snowman 92]

Chào Bác Hoành!

 

Em làm trên AutoCAD cũng lâu lâu rồi, nhưng mới biết đến mạng mẹo - đúng là hay thật.

 

Em làm về Bản đồ phục vụ công trình. Em vẽ đường Đồng mức (bằng PolyLine), và nhập Cao độ cho nó bẳng cách nhập thủ công vào Elevation. Bác có thể viết cho Em 1 Lisp để có thể nhập giá trị cao độ nhanh hơn không ạ? Em nghĩ là về thuật toán thì có thể viết được-chắc là phải viết nhiều lắm, và Em thì chẳng biết gì về Lisp cả. Mong nhận được sự giúp đỡ của Bác. Cảm ơn Bác trước.

Đây có thể là lisp bạn cần: lệnh ep để nhập 1 cao độ cho nhiều đường, lệnh mep để nhập cao độ khác nhau cho nhiều đường (chọn tất cả và lệnh sẽ zoom từng đường để bạn vào số liệu, hoặc nhập theo thứ tự tăng dần cao độ - phải chọn polyline theo đúng thứ tự: pick hoặc dùng fence line)

(defun myerror (s)
 (cond
   ((= s "quit / exit abort") (princ))
   ((/= s "Function cancelled") (princ (strcat "\nError: " s)))
 )
 (setvar "cmdecho" CMD)		; Restore saved modes
 (setvar "osmode" OSM)
 (setq *error* OLDERR)			; Restore old *error* handler
 (princ)
)

;;;=========================================================================
(defun bocchu (ss1 c)
 (setq ob (entget (ssname ss1 c)))
 (setq ts (assoc 1 ob))
 (setq a (cdr ts))
)

(defun boc1chu (ob)
 (setq ts (assoc 1 ob))
 (setq a (cdr ts))
)


(defun Txtnum (num)
 (if (> num 0)
   (strcat "+" (rtos num 2 0))
   (rtos num 2 0)
 )
)
;;;=================================
(defun Txtint (num)
 (rtos num 2 0)

)

(defun Txtreal (num) (rtos num 2 2))
(defun Txtreal1 (num) (rtos num 2 0))

(defun thaychu (Ob newstr / obtmp)
 (setq txtstr (assoc 1 Ob))
 (setq newstr (cons 1 newstr)
obtmp (entmod (subst newstr txtstr Ob))
)
 (entupd (cdr (assoc -1 obtmp)))
)
(defun chonchu (dongnhac)
 (prompt dongnhac)
 (ssget
   '((-4 . "<OR") (0 . "text") (0 . "mtext") (0 . "ATTRIB") (-4 . "OR>"))
 )
)

(defun chon1chu	(dongnhac / obj objtype)
 (if (setq obj (nentsel dongnhac))
   (setq obj (entget (car obj))
  objtype (cdr (assoc 0 obj))
  )
   )
 (if (member objtype '("ATTRIB" "MTEXT" "TEXT"))
   (setq obj obj)
   )
)




(defun chon (str) (ssget '((cons (0 str)))))
(defun bamchon (st) (entget (car (entsel st))))
(defun bocdt (ss1 c) (entget (ssname ss1 c)))



;;;=============================================================================

=================
(Defun PlMake (Plist)			;  Create polyline entities
 (entmake '((0 . "POLYLINE")))
 (setq	n  (length Plist)
ic 0
 )
 (while (< ic n)
   (entmake (list (cons 0 "VERTEX") (cons 10 (nth ic Plist))))
   (setq ic (1+ ic)
   )
 )
 (entmake '((0 . "SEQEND")))

)

;;;===========================================================
;;;                 Tao cac layer
(Defun Laymake ()
 (command "regenauto" "off")
 (if (= (tblsearch "LAYER" "Kyhieuga") nil)
   (progn
     (command "layer" "n" "Kyhieuga" "")
     (princ)
     (command "layer" "c" 8 "Kyhieuga" "")
     (princ)
   )
 )
 (if (= (tblsearch "LAYER" "Kyhieuganb") nil)
   (progn
     (command "layer" "n" "Kyhieuganb" "")
     (princ)
     (command "layer" "c" 8 "Kyhieuganb" "")
     (princ)
   )
 )


 (if (= (tblsearch "LAYER" "TxtGT") nil)
   (progn
     (command "layer" "n" "TxtGT" "")
     (princ)
     (command "layer" "c" 7 "TxtGT" "")
     (princ)
   )
 )
 (if (= (tblsearch "LAYER" "TxtCDMG") nil)
   (progn
     (command "layer" "n" "TxtCDMG" "")
     (princ)
     (command "layer" "c" 1 "TxtCDMG" "")
     (princ)
   )
 )
 (if (= (tblsearch "LAYER" "TxtCDDC") nil)
   (progn
     (command "layer" "n" "TxtCDDC" "")
     (princ)
     (command "layer" "c" 2 "TxtCDDC" "")
     (princ)
   )
 )
 (if (= (tblsearch "LAYER" "TxtCDDG") nil)
   (progn
     (command "layer" "n" "TxtCDDG" "")
     (princ)
     (command "layer" "c" 3 "TxtCDDG" "")
     (princ)
   )
 )
 (command "regenauto" "on")
 (princ)
)

;;;=========================================================
(defun arrow (P1 P2 Htxt / Pm wid)
 (setq Plw (getvar "PLineWid"))
 (Setq	wid (/ Htxt 4)
Pm  (list (/ (+ (car P1) (car P2)) 2)
	  (/ (+ (cadr P1) (cadr P2)) 2)
    )
 )
 (command "Pline" P1 "W" 0 wid Pm "W" 0 0 P2 "")
)
;;;=======================================================
;;;	 Ham nhan list dinh tu Polyline								
;;;
(defun Getvpl (ename / Elist rep e1 dp c)
 (setq	rep "C"
Elist '()
c 1
 )
 (setq
   ename (entnext ename))
 (while (/= rep "SEQEND")
   (setq e1 (entget ename))
   (setq rep (cdr (assoc 0 e1)))
   (if	(/= rep "VERTEX")
     (princ)
     (progn
(setq dp (cdr (assoc 42 e1)))
(setq
  elist	(cons (cons c
		    (reverse (cdr (reverse (cdr (assoc 10 e1))
				  )
			     )
		    )
	      )
	      elist
	)
)
     )
   )
   ;;end if
   (setq ename	(entnext ename)
  c	(1+ c)
   )
 )
 ;;end while
 (setq elist (reverse elist))
 ;;kthuc 
)
;;;
;;;	 Ham nhan list dinh tu LWPolyline								
;;;
(defun Getvlw (ename / di i e1 elist dp c)
 (setq e1 (entget ename))
 (setq	elist '()
c 1
c1 1
 )
 (while e1
   (setq di (car e1))
   (if	(/= 10 (car di))
     (princ)
     (progn
(setq vlap 1
      dp nil
)
(while (and e1 (/= vlap 42))
  ;;never null
  (setq i (car e1))
  (setq vlap (car i))
  (if (/= vlap 42)
    (setq e1 (cdr e1))
    (setq dp (cdr i))
  )
)
;;end while
(if (null dp)
  (alert "Error bulge in the LWPOLYLINE")
  ;;nerver appear 
  (setq	elist (cons (cons c1 (cdr di)) elist)
	c1    (1+ c1)
  )
)
;;end if
     )
   )
   ;;end if
   (setq e1 (cdr e1)
  c  (1+ c)
   )
 )
 ;;end while
 (setq elist (reverse elist))
)

;;;================================================Nhap gia tri cao do cho nhieu polyline
(defun C:ep (/ sspl evl)
 (command "undo" "begin")
 (setvar "cmdecho" 0)
 (setq	sspl (ssget '((-4 . "<OR")
	      (0 . "Polyline")
	      (0 . "LWpolyline")
	      (-4 . "OR>")
	     )
     )
cter 0
 )
;;; Nhap du lieu (lay gia tri mac dinh la gia tri da nhap vao truoc do), neu su dung lan dau, mac dinh la 0
 (if oldstr
   (if	(= nil (setq evl (getreal oldstr)))
     (if oldevl
(setq evl oldevl)
(setq evl 0.00)
     )
   )
   (progn
     (setq oldstr "\nNhap vao gia tri cao do: <Enter for 0.00> ")
     (if (= nil
     (setq evl (getreal oldstr))
  )
(setq evl 0.00)
     )
   )
 )
 (setq	oldevl evl
oldstr (strcat "\nNhap vao gia tri cao do: <Enter for "
	       (rtos oldevl 2 2)
	       "> "
       )
 )
;;; ket thuc nhap du lieu
 (while (< cter (sslength sspl))
   (setq objpl	 (ssname sspl cter)
  entpl	 (entget objpl)
  pltype (cdr (assoc 0 entpl))
  cter	 (1+ cter)
   )
   (cond
     ((= pltype "POLYLINE")
      (setq evlpl  (cdr (assoc 10 entpl))
     newevl (cons 10 (list (car evlpl) (cadr evlpl) evl))
     entpl  (entmod (subst newevl (assoc 10 entpl) entpl))
      )
      (entupd objpl)
     )
     ((= pltype "LWPOLYLINE")
      (setq evlpl  (cdr (assoc 38 entpl))
     newevl (cons 38 evl)
     entpl  (entmod (subst newevl (assoc 38 entpl) entpl))
      )
      (entupd objpl)
     )
   )
 )
 (command "undo" "end")
 (setvar "cmdecho" 1)
 (princ)
)
;;;=============================================================================

============
;;; Nhap gia tri cao do cho nhieu polyline (moi polyline co mot gia tri cao do khac nhau
(defun C:mep (/ sspl evl)
 (command "undo" "begin")
 (setvar "cmdecho" 0)
 (setq	sspl (ssget '((-4 . "<OR")
	      (0 . "Polyline")
	      (0 . "LWpolyline")
	      (-4 . "OR>")
	     )
     )
cter 0
 )
 (initget "Y N")
 (if (= nil
 (setq res
	(getkword
	  "\nCo nhap buoc nhay cho duong dong muc ko? <Y/N - Enter for none>: "
	)
 )
     )
   (setq step 0)
   (if
     (= nil
 (setq
   step	(getreal "\nNhap gia tri buoc nhay <Enter for 0.1>: ")
 )
     )
      (setq step 0.1)
   )
 )
 (while (< cter (sslength sspl))
   (setq objpl	 (ssname sspl cter)
  entpl	 (entget objpl)
  pltype (cdr (assoc 0 entpl))
  cter	 (1+ cter)
   )
   (cond
     ((= pltype "POLYLINE")
      (setq
 polist	(getvpl objpl)
      )
     )
     ((= pltype "LWPOLYLINE")
      (setq polist (getvlw objpl)
      )
     )
   )

   (setq Xmax (car (cdr (nth 0 polist)))
  Xmin (car (cdr (nth 0 polist)))
  Ymax (cadr (cdr (nth 0 polist)))
  Ymin (cadr (cdr (nth 0 polist)))
  ctmax 0)
   (repeat (length polist)
     (if (<= xmax (car (cdr (nth ctmax polist))))
(setq xmax (car (cdr (nth ctmax polist))))
)
     (if (>= xmin (car (cdr (nth ctmax polist))))
(setq xmin (car (cdr (nth ctmax polist))))
)
     (if (<= Ymax (cadr (cdr (nth ctmax polist))))
(setq Ymax (cadr (cdr (nth ctmax polist))))
)
     (if (>= Ymin (cadr (cdr (nth ctmax polist))))
(setq Ymin (cadr (cdr (nth ctmax polist))))
)
     (setq ctmax (1+ ctmax))
     )
   (setq ppl  (list Xmax Ymax)
  ppl1 (list Xmin Ymin ) 
   )
   (command "zoom" "W"	ppl ppl1)

   (redraw objpl 3)
;;; Nhap du lieu (lay gia tri mac dinh la gia tri da nhap vao truoc do), neu su dung lan dau, mac dinh la 0
   (if	oldstr
     (if (= nil (setq evl (getreal oldstr)))
(if oldevl
  (setq evl oldevl)
  (setq evl 0.00)
)
     )
     (progn
(setq oldstr "\nNhap vao gia tri cao do: <Enter for 0.00> ")
(if (= nil
       (setq evl (getreal oldstr))
    )
  (setq evl 0.00)
)
     )
   )
   (setq oldevl (+ evl step)
  oldstr (strcat "\nNhap vao gia tri cao do: <Enter for "
		 (rtos oldevl 2 2)
		 "> "
	 )
   )
;;; ket thuc nhap du lieu

   (cond
     ((= pltype "POLYLINE")
      (setq evlpl  (cdr (assoc 10 entpl))
     newevl (cons 10 (list (car evlpl) (cadr evlpl) evl))
     entpl  (entmod (subst newevl (assoc 10 entpl) entpl))
     polist (getvpl objpl)
      )
      (entupd objpl)
     )
     ((= pltype "LWPOLYLINE")
      (setq evlpl  (cdr (assoc 38 entpl))
     newevl (cons 38 evl)
     entpl  (entmod (subst newevl (assoc 38 entpl) entpl))
     polist (getvlw objpl)
      )
      (entupd objpl)
     )
   )
   (redraw objpl 4)
 )
 (command "undo" "end")
 (setvar "cmdecho" 1)
 (princ)
)

[LXD 12]

Ối!

 

Cảm ơn Bác Snowman nhiều nhiều. Em sẽ thử ngay.

[LXD 12]

Bác Snowman ơi!

 

Có tý vấn đề roài. Lệnh "ep" chạy tốt. Còn lệnh "mep"- nhập giá trị cao độ cho nhiều đường có chút vấn đề, Bác xem hộ em có Copy sai chỗ nào không với nhá.

 

Command: mep

 

Select entities:

Select entities:

 

Co nhap buoc nhay cho duong dong muc ko? <Y/N - Enter for none>: y

 

Nhap gia tri buoc nhay <Enter for 0.1>: 2

error: null function

(GETVLW OBJPL)

(SETQ POLIST (GETVLW OBJPL))

(COND ((= PLTYPE "POLYLINE") (SETQ POLIST (GETVPL OBJPL))) ((= PLTYPE "LWPOLYLINE") (SETQ POLIST (GETVLW OBJPL))))

(WHILE (< CTER (SSLENGTH SSPL)) (SETQ OBJPL (SSNAME SSPL CTER) ENTPL (ENTGET OBJPL) PLTYPE (CDR (ASSOC 0 ENTPL)) CTER (1+ CTER)) (COND ((= PLTYPE "POLYLINE") (SETQ POLIST (GETVPL OBJPL))) ((= PLTYPE "LWPOLYLINE") (SETQ POLIST (GETVLW OBJPL)))) (SETQ XMAX (CAR (CDR (NTH 0 POLIST))) XMIN (CAR (CDR (NTH 0 POLIST))) YMAX (CADR (CDR (NTH 0 POLIST))) YMIN (CADR (CDR (NTH 0 POLIST))) CTMAX 0) (REPEAT (LENGTH POLIST) (IF (<= XMAX (CAR (CDR (NTH CTMAX POLIST)))) (SETQ XMAX (CAR (CDR (NTH CTMAX POLIST))))) (IF (>= XMIN (CAR (CDR (NTH CTMAX POLIST)))) (SETQ XMIN (CAR (CDR (NTH CTMAX POLIST))))) (IF (<= YMAX (CADR (CDR (NTH CTMAX POLIST)))) (SETQ YMAX (CADR (CDR (NTH CTMAX POLIST))))) (IF (>= YMIN (CADR (CDR (NTH CTMAX POLIST)))) (SETQ YMIN (CADR (CDR (NTH CTMAX POLIST))))) (SETQ CTMAX (1+ CTMAX))) (SETQ PPL (LIST XMAX YMAX) PPL1 (LIST XMIN YMIN)) (COMMAND "zoom" "W" PPL PPL1) (REDRAW OBJPL 3) (IF OLDSTR (IF (= nil (SETQ EVL (GETREAL OLDSTR))) (IF OLDEVL (SETQ EVL OLDEVL) (SETQ EVL 0.000000))) (PROGN (SETQ OLDSTR "\nNhap vao gia tri cao do: <Enter for 0.00> ") (IF (= nil (SETQ EVL (GETREAL OLDSTR))) (SETQ EVL 0.000000)))) (SETQ OLDEVL (+ EVL STEP) OLDSTR (STRCAT "\nNhap vao gia tri cao do: <Enter for " (RTOS OLDEVL 2 2) "> ")) (COND ((= PLTYPE "POLYLINE") (SETQ EVLPL (CDR (ASSOC 10 ENTPL)) NEWEVL (CONS 10 (LIST (CAR EVLPL) (CADR EVLPL) EVL)) ENTPL (ENTMOD (SUBST NEWEVL (ASSOC 10 ENTPL) ENTPL)) POLIST (GETVPL OBJPL)) (ENTUPD OBJPL)) ((= PLTYPE "LWPOLYLINE") (SETQ EVLPL (CDR (ASSOC 38 ENTPL)) NEWEVL (CONS 38 EVL) ENTPL (ENTMOD (SUBST NEWEVL (ASSOC 38 ENTPL) ENTPL)) POLIST (GETVLW OBJPL)) (ENTUPD OBJPL))) (REDRAW OBJPL 4))

(C:MEP)

Command:

[Snowman 92]

Tôi test lại rồi, ko thiếu đoạn nào cả, có thể bạn copy thiếu hoặc làm lỗi một dòng nào đó.

Cái này tôi vẫn dùng thường xuyên mà. Để chắc ăn tôi đưa lên file luôn nhé!

 

File chuan day!

[Phiphi- 176]

Tôi test lại rồi, ko thiếu đoạn nào cả, có thể bạn copy thiếu hoặc làm lỗi một dòng nào đó.

Cái này tôi vẫn dùng thường xuyên mà. Để chắc ăn tôi đưa lên file luôn nhé!

 

File chuan day!

Bác có thể up luốn 1 template drawing để bà con xài nhé. Thanks you Bác

[LXD 12]

Tôi test lại rồi, ko thiếu đoạn nào cả, có thể bạn copy thiếu hoặc làm lỗi một dòng nào đó.

Cái này tôi vẫn dùng thường xuyên mà. Để chắc ăn tôi đưa lên file luôn nhé!

 

File chuan day!

 

Cảm ơn Bác Snowman nhiều nhắm.

 

Em thử lại rồi. Quá xuất sắc.

 

Hy vọng trong thời gian tới được chia sẻ với bác nhiều hơn.

 

Một lần nữa xin cảm ơn Bác./.

[Phiphi- 176]

Xin nhờ các Bác viết cho 1 đoạn LISP về Xref mẫu để PP sẽ tập viết tiếp.

 

a. Dùng lệnh Xref, mình có n bản vẽ dành cho Xref được lưu trong đường dẩn D:\ProjectA\Drawings\XREF

1. Đánh XbvA1 thì lệnh Xref sẽ Attach bản vẽ mặc định là bvA (filename sẽ khác) (1=on, 0=off) Khi attach vào b/v thì Draw order là Send to Back

2. Đánh XbvA0 thì lệnh Xref sẽ Detach bản vẽ mặc định là bvA ...Làm tương tư cho các b/v 1...n

3. Đánh XALL1 thì lệnh Xref sẽ Attach tất cả n bàn vẽ vào bv đang vẽ với mặc định: Insertion Point 0,0,0 - Scale: 1,1,1 - Rotate: 0d - Full path (1=on, 0=off)

4. Đánh XALL0 thì lệnh Xref sẽ Detach tất cả n bàn vẽ

 

b. Dùng lệnh Copy with Base point: Có 2 bản vẽ A và B

1. Đánh AB, lệnh Copy with Base point hoat động, LISP tự động đặt x=0, y=0

2. Select object ở bản vẽ A, Enter

3. Right click trên bản vẽ B để chọn lệnh Paste, enter

4. Object sẽ tự dộng nhập vảo bản vẽ B với Insertion point là x=0, y=0

 

Hai LISP trên có thể sử dụng để insert khung tên trong các Layout và ứng dụng nhiều việc khác nữa.

Xin cảm ơn nhiều.

[HoangSon614 66]

Bạn có thể post yêu cầu về autolisp ở topic này.

Các bạn sửa giúp mình đoạn lisp này với:

Mình đang sử dụng lisp vẽ trắc dọc ống cấp nước, gặp lỗi sau:

- Khi đã có bản vẽ trắc dọc sẵn (từ cọc A1 - A5). Tại dònh command nhập lệnh QTD thì chương trình hỏi: <1.Vẽ mới/2. Tiếp tục>, mình chọn "2. Tiếp tục" nhưng điểm bắt đầu nối tiếp không phải là (cọc A6 - A7) có file vẽ kèm theo.

Các bạn có thể cho chạy chương trình và xem thêm phần vướng mắc mình nêu ở trên để tìm ra lỗi và sửa giúp mình (mình biết có rất nhiều cao thủ về lisp). Mình đang rất cần để làm công trình, các bạn cố gắng xem và sửa giúp mình. Cảm ơn các bạn rất nhiều.

 

File ví dụ:

http://www.cadviet.com/upfiles/Vi_du_trac_doc_2.dwg

[hoangkimanh1607 0]

Chào bác Nguyễn Hoàng nho bac sửa dùm tui đọan list này nhé.Thanks

 

Tinh dien tich va ghi ra file

(defun C:dtt (/ A Ar te B P P0)

(setvar "cmdecho" 0)

(setq fq (open "C:\dien_tich.txt""Ar" ))

(princ "Chon ten mat cat : ")

(setq ss1 (ssget))

(setq ent (ssname ss1 0))

(setq object (entget ent))

(setq ten_mc (cdr (assoc 1 object)))

(Setq P (getpoint "\nChon vung lam viec: "))

(if (tblsearch "layer" "dien_tich")

(command ".layer" "S" "dien_tich" "")

(command ".layer" "N" "dien_tich" "c" 4 "dien_tich" "s" "dien_tich" "")

)

(command ".boundary" P "")

(setq L1 "last")

(command ".area" "entity" L1)

(command ".Hatch" "Ansi37" 70 0 L1 "")

(setq Ar (getvar "area"))

(setq B (/ (float(fix(* Ar 1 100)))100))

(setq A (rtos B ))

(setq te (strcat A " "))

(setq P0 (list (-(car P) 0.76)(-(cadr P) 0.63)))

;; (command ".text" "s" "a" "")

(command ".text" "J" "R" P0 "0.7" te )

;

convert real --> string

(setq text_str (rtos B ))

(setq text_info (strcat ten_mc "," text_str ))

(write-line text_info fq)

(setq tdxt (nth 0 ptt) tdyt (nth 1 ptt))

(command "text" (list (+ tdxt 5.0) (+ tdyt 0.5)) 3.5 0 ten_mc)

(command "text" (list (+ tdxt 26.5) (+ tdyt 0.5)) 3.5 0 (rtos B 2 3))

(close fq)

)

(print)

 

;

[gia_bach 1.550]

Chào bác Nguyễn Hoàng nho bac sửa dùm tui đọan list này nhé.Thanks

Tinh dien tich va ghi ra file

;

 

Đoạn list của bạn đây :

(defun C:dtt (/ A Ar te S P P0)
 (setvar "cmdecho" 0)
 (setq fq (open "C:\\dien_tich.txt" "Ar"))
 (princ "Chon ten mat cat : ")
 (setq ss1 (ssget))
 (setq ent (ssname ss1 0))
 (setq object (entget ent))
 (setq ten_mc (cdr (assoc 1 object)))
 (Setq P (getpoint "\nChon vung lam viec: "))
 (if (tblsearch "layer" "dien_tich")
   (command ".layer" "S" "dien_tich" "")
   (command ".layer" "N" "dien_tich" "c" 4 "dien_tich" "s" "dien_tich" "" )
 )
 (command ".boundary" P "")
 (setq L1 "last")
 (command ".area" "entity" L1)
 (command ".Hatch" "Ansi37" 70 0 L1 "")
 (setq Ar (getvar "area"))
 (setq S (/ (float (fix (* Ar 1 100))) 100))
 (setq A (rtos S))
 (setq te (strcat A " "))
 (setq P0 (list (- (car P) 0.76) (- (cadr P) 0.63)))
 (command ".text" "J" "R" P0 3.5 0 te)
;convert real --> string
 (setq text_str (rtos S))
 (setq text_info (strcat ten_mc "," text_str))
 (write-line text_info fq)
 (setq	tdxt (nth 0 P0)
tdyt (nth 1 P0)
 )
 (command "text" (list (+ tdxt 5.0) (+ tdyt 0.5)) 3.5 0 ten_mc )
 (command "text" (list (+ tdxt 26.5) (+ tdyt 0.5))3.5 0 (rtos S 2 3) )
 (close fq)
)

[hoangkimanh1607 0]

Thanks bác nhé ah bác có đọan list nào về trải mái ko, cụ thể là mình có 2 đọan pl hoặc line mình muốn tự động va tính ra đọan ngắn = 1/3 đọan dài và các mái đó cứ 1 khoảng cách lải có 1 kí hiệu mái nếu ghi dc tên mái m= thi cang tốt thanks

[HoangSon614 66]

Các bạn sửa giúp mình đoạn lisp này với:

Mình đang sử dụng lisp vẽ trắc dọc ống cấp nước, gặp lỗi sau:

- Khi đã có bản vẽ trắc dọc sẵn (từ cọc A1 - A5). Tại dònh command nhập lệnh QTD thì chương trình hỏi: <1.Vẽ mới/2. Tiếp tục>, mình chọn "2. Tiếp tục" nhưng điểm bắt đầu nối tiếp không phải là (cọc A6 - A7) có file vẽ kèm theo.

Các bạn có thể cho chạy chương trình và xem thêm phần vướng mắc mình nêu ở trên để tìm ra lỗi và sửa giúp mình (mình biết có rất nhiều cao thủ về lisp). Mình đang rất cần để làm công trình, các bạn cố gắng xem và sửa giúp mình. Cảm ơn các bạn rất nhiều.

 

File ví dụ:

http://www.cadviet.com/upfiles/Vi_du_trac_doc_2.dwg

;--------------------------------

;;function set parameter

(defun Init ()

(setvar "BLIPMODE" 0)

(setvar "CMDECHO" 0)

(setvar "ANGBASE" 0)

);;

;--------------------------------

;;function return parameter

(defun Reinit ()

(setvar "BLIPMODE" 0)

(setvar "CMDECHO" 1)

(setvar "ANGBASE" 0)

)

;--------------------------------

;;function change degree to radian

(defun doi (a)

(* PI (/ a 180))

)

;--------------------------------

;function set corner by radian

(defun doi1 ()

(setq a 1.5707965 a45 0.78539825

b 3.141593 b45 -0.78539825

c 4.7123895

)

)

;--------------------------------

;;function change radian to degree

(defun doi2 (d)

(* 180 (/ d pi))

)

;;

;--------------------------------

; make layer

(defun taolop ()

(command

"-OSNAP" "OFF" ""

"layer" "m" "manh" "c" "7" "" "l" "continuous" "" ""

"layer" "m" "giong" "c" "7" "" "l" "continuous" "" ""

"layer" "m" "bao" "c" "6" "" "l" "continuous" "" ""

"layer" "m" "ong" "c" "1" "" "l" "continuous" "" ""

"layer" "m" "day" "c" "1" "" "l" "continuous" "" ""

"layer" "m" "daydut" "c" "1" "" "l" "dashed" "" ""

"layer" "m" "chua" "c" "3" "" "l" "continuous" "" ""

"layer" "m" "chuv" "c" "3" "" "l" "continuous" "" ""

"style" "chuv1" "VNI-times" "" "0.8" "" "" "" ""

"style" "chuv" "VNI-Helve-condense" "" "1" "" "" "" ""

"style" "chua" "romans.shx" "" "0.7" "" "" "" ""

)

)

;

;--------------------------------

;---------------------------------

;1 ENDP 2 MID 4 CEN 8 NODE 16 QUA 32 INT 64 INS 128 PER 256 TAN 512 NEA 1024 QUI

;;ONAP ENDP INT(MID) NEAR

(defun onap ()

(setvar "OSMODE" (+ 1 32 512))

)

;;;;ONAP ENDP INT(MID) CEN

(defun onap1 ()

(setvar "OSMODE" (+ 1 4 32))

)

;;;

;;;;ONAP ENDP INT(MID) CEN

(defun onap2 ()

(setvar "OSMODE" (+ 1 2 4 16 32 128 512))

)

;;;;;;

(defun ofnap ()

(command "-OSNAP" "OFF" "" )

)

;----------------------------(ofnap) (onap2)

(defun COCSS()

(doi1)

(setq

i 1

j 0

Ess1 (+ Ess 1)

Ptssx (polar Ptss 0 -1) Ptssx1 (polar Ptssx a (* Esn Td))

Ptssy (polar Ptss 0 1) Ptssy1 (polar Ptssy a (* Esn Td))

)

(Repeat Esn

(setq Ess2 (rtos Ess1 2 2)

Ptss2 (polar Ptss 0 (* i 0.5))

Ptss21 (polar Ptss2 a (* j Td)) Ptss22 (polar Ptss21 a Td)

Ptss3 (polar Ptss 0 -1)

Ptss31 (polar Ptss3 a (+ (* j Td) Td)) Ptss32 (polar Ptss31 0 -5)

Ptss33 (polar Ptss32 0 -1)

)

(command

"layer" "s" "manh" ""

"pline" Ptss21 "w" 1.0 1.0 Ptss22 ""

"line" Ptss31 Ptss32 ""

"layer" "s" "chuv" ""

"style" "chuv" "VNI-Helve-condense" "" "1" "" "" "" ""

"text" "j" "mr" Ptss33 2.5 0.0 (strcat Ess2)

)

(setq

i (* i -1)

j (+ j 1)

Ess1 (+ Ess1 1)

)

);endrepeat

(command "layer" "s" "manh" "" "pline" Ptssx "w" 0.0 0.0 Ptssx1 Ptssy1 Ptssy ""

)

);end function comparation (princ lis)

;==========================

;function main

(defun C:QTD ()

(Init)

(taolop)

(doi1)

;-----------------------------------------

(setq

Tln (getint "\nTy le ngang :")

Tld (getint "\nTy le dung :")

Tn (/ 1000 Tln)

Td (/ 1000 Tld)

)

;-----------------------------------------

(setq LisLkcd1 nil LisLkcd nil

LisLkcdo nil)

(initget "Moi Tieptuc")

(setq Ansertt (getint "\nVe moi hay tiep tuc <1.Moi/2.Tieptuc> :")

)

(cond

((= Ansertt 1)

(setq

Kcdo 0 LisLkcdo (cons Kcdo LisLkcdo)

Kcd 0 LisLkcd1 (cons Kcd LisLkcd1)

LisLkcd LisLkcdo)

)

((= Ansertt 2)

(setq

Kcdo (getreal "\nChieu dai tai coc tiep theo (m):");distance 2 station

Kcd (* Kcdo Tn) ; distance

LisLkcd (cons (- Kcdo Kcdo) LisLkcd)

LisLkcdo (cons Kcdo LisLkcdo)

LisLkcd1 (cons Kcd LisLkcd1))

)

)

(QHD)

)

(defun QHD()

(progn

;------------------------------------(princ lis)

(onap)

(setq Pta (getpoint "\nChon diem bat dau ve :")

Pta1 (polar pta 0 60)

Pta2 (polar pta 0 5)

Pta3 (polar pta2 c 5)

Ptss1 (polar pta 0 57)

Ptss (polar Ptss1 a 70)

Ess (getreal "\nCao do so sanh <m>:")

Esn (getint "\nSo moc so sanh :")

Es (rtos Ess 2 2)

VL (getint "\nVat lieu ong </0.STK/1.PVC/2.THEP/3.GANG/4.BTONG/5.BTCT/6.SANH/7.HDPE>:")

D (getreal "\nDuong kinh ong <mm>:")

Ho (getreal "\nDo sau chon ong ban dau (m):")

i 0

LisCSS '("[sTAKE NO.]" "TEÂN COÏC"

"[ANGLE OF DIRECTION]" "GOÙC QUAY MAËT BAÈNG (ÑOÄ)"

"[ACCU. DISTANCE]" "KHOÛANG CAÙCH COÄNG DOÀN (m)"

"[DIA - GRADIENT.]" "ÑÖÔØNG KÍNH - ÑOÄ DOÁC (%)"

"[DEPTH .]" "ÑOÄ SAÂU CHOÂN OÁNG (m)"

"[PIPE BOTTOM ELEV.]" "CAO ÑOÄ ÑAÙY OÁNG (m)"

"[GROUND ELEV.]" "CAO ÑOÄ MAËT ÑAÁT (m)"

"[DATUM.]" "COÁT SO SAÙNH")

LisTs '("Cot mat dat <m> coc so" "Do doc doan ong giua hai coc"

"Khoang cach <m> giua hai coc"

"Goc quay mat bang coc so")

LisVL '("STK" "PVC" "THEÙP" "GANG" "BT" "BTCT" "SAØNH" "HDPE")

Lismd nil Lisdo nil LisHo nil Lisi nil Lisio nil LisLkc nil LisLkco nil

LisTcoc nil LisGoc nil LisDeltaMD nil LisdeltaDO nil

)

(ofnap)

;--------

;-------------------------------------------

;data stake no.

(setq k (getint "\nSo coc:")

CTc (getstring "\nKy tu dau cua coc:")

Tcoc (getint "\nTen coc dau tien hoac tiep theo:")

Ki Tcoc

i1 Tcoc

i2 Tcoc

i3 Tcoc

i4 Tcoc

i5 Tcoc

)

(repeat k

(progn

(setq

LisTcoc (cons Tcoc LisTcoc)

Tcoc (1+ Tcoc)

)

);endprogn

);endrepeat;(princ Lis)

(setq LisTcoc (reverse LisTcoc))

;-------------------------------------------

;data ground level.

(repeat k

(progn

(print (nth 0 LisTs)) (prin1 CTc) (prin1 Ki)

(setq

Cmdo (getreal "\nCao do mat dat (m) :")

Cmd Cmdo

Lismd (cons Cmd Lismd)

Ki (1+ Ki)

)

);endprogn

);endrepeat;(princ Lis)

(setq Lismd (reverse Lismd))

;-------------------------------------------

;data gradient.

(repeat (- k 1)

(progn

(print (nth 1 LisTs)) (prin1 CTc) (prin1 i1) (prin1 CTc) (prin1 (+ i1 1))

(setq

io (getreal "\nDo doc dat ong <+ doc xuoi/- doc nguoc> (%) :")

io1 (/ io 100) Lisi (cons io1 Lisi)

io2 (* io 1000) Lisio (cons io2 Lisio)

i1 (1+ i1)

)

);endprogn

);endrepeat;(princ Lis)

(setq Lisi (reverse Lisi) Lisio (reverse Lisio))

;-------------------------------------------

;data distance.

(repeat (- k 1)

(progn

(print (nth 2 LisTs)) (prin1 CTc) (prin1 i2) (prin1 CTc) (prin1 (+ i2 1))

(setq

Kco (getreal "\nKhoang cach giua hai coc (m):");distance 2 station

Kc (* Kco Tn) ; distance

LisLkco (cons Kco LisLkco)

LisLkc (cons Kc LisLkc)

i2 (1+ i2)

)

);endprogn

);endrepeat;(princ Lis)

(setq LisLkc (reverse LisLkc) LisLkco (reverse LisLkco))

;----------------------------------------

;mapcar Kcdo Kcd1

(setq n1 0 Kcd1 0)

;Kcdo 0 LisLkcdo (cons Kcdo LisLkcdo)

;Kcd 0 LisLkcd1 (cons Kcd LisLkcd1))

(mapcar

'(lambda (Kco Kc)

(setq

Kcdo (+ Kcdo (nth n1 LisLkco)) LisLkcdo (cons Kcdo LisLkcdo)

Kcd (+ Kcd (nth n1 LisLkc)) LisLkcd1 (cons Kcd LisLkcd1)

Kcd1 (+ Kcd1 (nth n1 LisLkc)) LisLkcd (cons Kcd1 LisLkcd)

n1 (1+ n1)

)

);endlambda

LisLkco LisLkc

);endmapcar

(setq LisLkcdo (reverse LisLkcdo) LisLkcd1 (reverse LisLkcd1) LisLkcd (reverse LisLkcd))

;----------------------------------------

;mapcar deltaMD deltaDO

(setq n2 1

n3 0

LisHo (cons Ho LisHo)

Cdo (- (nth 0 Lismd) Ho) Lisdo (cons Cdo Lisdo)

DeltaMD (* (- (nth 0 Lismd) Ess) Td) DeltaDO (* (- (nth 0 Lismd) Ess Ho) Td)

LisDeltaMD (cons DeltaMD LisDeltaMD) LisDeltaDo (cons DeltaDo LisDeltaDo))

(mapcar

'(lambda (Cmd io1 Kco)

(setq

Cdo (- Cdo (* Kco (nth n3 Lisi))) Lisdo (cons Cdo Lisdo)

Ho (- (nth n2 Lismd) Cdo) LisHo (cons Ho LisHo)

DeltaMD (* (- (nth n2 Lismd) Ess) Td) LisDeltaMD (cons DeltaMD LisDeltaMD)

DeltaDO (- deltaDO (* (nth n3 LisLkco) (nth n3 Lisi) Td))

LisDeltaDO (cons DeltaDO LisDeltaDO)

n2 (1+ n2)

n3 (1+ n3)

)

);endlambda

Lismd Lisi LisLkco

);endmapcar

(setq LisDeltaMD (reverse LisDeltaMD) LisDeltaDO (reverse LisDeltaDO)

LisHo (reverse LisHo) Lisdo (reverse Lisdo))

;-------------------------------------------

;data cornor.

(repeat k

(progn

(print (nth 3 LisTs)) (prin1 CTc) (prin1 i3)

(setq

Gmb (getreal "\nGoc quay mat bang :")

LisGoc (cons Gmb LisGoc)

i3 (1+ i3)

)

);endprogn

);endrepeat;(princ Lis)

(setq LisGoc (reverse LisGoc))

;-------------------------------------------

(Repeat 8

(setq Ptb (polar Pta a (* i 10))

Ptc (polar Pta1 a (* i 10))

ptd (polar pta2 a (+ (* i 10) 2.7))

pte (polar pta2 a (+ (* i 10) 7.25))

)

(command

"layer" "s" "manh" ""

"line" Ptb Ptc ""

"layer" "s" "chuv" ""

"style" "chuv" "VNI-Helve-condense" "" "1" "" "" "" ""

"text" "j" "ml" Pte 2.4 0.0 (nth (+ (* i 2) 1) LisCSS)

"text" "j" "ml" Ptd 2.4 0.0 (nth (* i 2) LisCSS)

)

(setq i (+ i 1))

);endrepeat

(command

"layer" "s" "manh" ""

"line" Pta Ptb ""

"layer" "s" "chuv" ""

"style" "chuv" "VNI-Helve-condense" "" "1" "" "" "" ""

"text" "j" "ml" Pta3 2.5 0.0 "DATUM IS X m ABOVE/BELOW NATIONAL DATUM"

)

;------------------------

(COCSS)

;draw one

(setq LisPTcoc nil PTcoc (polar Pta1 a 5) LisPTcoc (cons PTcoc LisPTcoc)

LisPGmb nil PGmb (polar Ptss1 a 17.5) LisPGmb (cons PGmb LisPGmb)

LisPGmb1 nil PGmb1 (polar Pta1 a 13) LisPGmb1 (cons PGmb1 LisPGmb1)

LisPKc nil PKc (polar Pta1 a 25) LisPKc (cons PKc LisPKc)

LisPdd nil Pdd (polar Pta1 a 30) LisPdd (cons Pdd LisPdd)

Pddi (polar pta1 a 30)

LisPho nil Pho (polar Pta1 a 45) LisPho (cons Pho LisPho)

LisPmd nil Pmd (polar Pta1 a 65) LisPmd (cons Pmd LisPmd)

LisPdo nil Pdo (polar Pta1 a 55) LisPdo (cons Pdo LisPdo)

LisPss nil Pss (polar Pta1 a 70) LisPss (cons Pss LisPss)

LisPssd nil LisPssd1 nil LisPssdo nil LisPssdo1 nil

V 0

)

(mapcar

'(lambda (Kc)

(setq

PTcoc (polar PTcoc 0 (nth V LisLkc)) LisPTcoc (cons PTcoc LisPTcoc)

PGmb (polar PGmb 0 (nth V LisLkc)) LisPGmb (cons PGmb LisPGmb)

PGmb1 (polar PGmb1 0 (nth V LisLkc)) LisPGmb1 (cons PGmb1 LisPGmb1)

PKc (polar PKc 0 (nth V LisLkc)) LisPKc (cons PKc LisPKc)

Pdd (polar Pdd 0 (nth V LisLkc)) LisPdd (cons Pdd LisPdd)

Pho (polar Pho 0 (nth V LisLkc)) LisPho (cons Pho LisPho)

Pmd (polar Pmd 0 (nth V LisLkc)) LisPmd (cons Pmd LisPmd)

Pdo (polar Pdo 0 (nth V LisLkc)) LisPdo (cons Pdo LisPdo)

Pss (polar Pss 0 (nth V LisLkc)) LisPss (cons Pss LisPss)

V (1+ V)

)

)

LisLkc

)

(setq LisPTcoc (reverse LisPTcoc)

LisPGmb (reverse LisPGmb) LisPGmb1 (reverse LisPGmb1)

LisPKc (reverse LisPKc)

LisPdd (reverse LisPdd)

LisPHo (reverse LisPHo) LisPmd (reverse LisPmd) LisPdo (reverse LisPdo)

LisPss (reverse LisPss)

V1 0)

;-----------

(mapcar

'(lambda (PTcoc PGmb PGmb1 PKc Pho Pmd Pdo Pss

Tcoc Gmb Kcdo Ho Cmd Cdo deltaMD deltaDO)

(setq

;parameter draw rotational corner

PGmb11 (polar PGmb1 0 -5) PGmb14 (polar PGmb1 0 2)

PGmb12 (polar PGmb14 a 4) PGmb13 (polar PGmb14 a 6);90

PGmb2 (polar PGmb1 a 2) PGmb21 (polar PGmb2 0 -7);<180

PGmb22 (polar PGmb2 a45 4.2) PGmb23 (polar PGmb2 a45 6.7);<180

PGmb24 (polar PGmb2 0 5) PGmb25 (polar PGmb2 0 7);=180

PGmb26 (polar PGmb2 b45 4.2) PGmb27 (polar PGmb2 b45 6.7);>180

PGmb3 (polar PGmb1 a 4) PGmb31 (polar PGmb3 0 -5) PGmb32 (polar PGmb3 0 2);270

PGmb33 (polar PGmb32 c 4) PGmb34 (polar PGmb32 c 6)

;end draw rotational corner

;parameter comparation

Pssd (polar Pss a (nth V1 LisDeltaMD)) LisPssd (cons Pssd LisPssd)

Pssdo (polar Pss a (nth V1 LisDeltaDO)) LisPssdo (cons Pssdo LisPssdo)

)

(command

"layer" "s" "chuv" ""

"style" "chuv" "VNI-Helve-condense" "" "1" "" "" "" ""

"text" "j" "mc" PTcoc 3.5 0.0 (strcat CTc (itoa (nth V1 LisTcoc)))

"text" "j" "mc" PKc 2.2 90.0 (rtos (nth V1 LisLkcdo) 2 2)

"text" "j" "mc" Pho 2.5 90.0 (rtos (nth V1 LisHo) 2 2)

"text" "j" "mc" Pmd 2.2 90.0 (rtos (nth V1 Lismd) 2 2)

"text" "j" "mc" Pdo 2.2 90.0 (rtos (nth V1 Lisdo) 2 2)

"layer" "s" "chua" ""

"style" "chua" "romans.shx" "" "0.7" "" "" "" ""

"text" "j" "mc" PGmb 2.5 0.0 (strcat (rtos (nth V1 LisGoc) 2 2) "%%d")

"layer" "s" "bao" ""

"circle" PTcoc "5"

"layer" "s" "giong" ""

"line" Pss Pssd ""

"layer" "s" "manh" "")

(cond

((= Gmb 90) (command "pline" PGmb11 PGmb14 PGmb12 "w" "1.0" "0" PGmb13 ""))

((< Gmb 180) (command "pline" PGmb21 PGmb2 PGmb22 "w" "1.0" "0" PGmb23 ""))

((= Gmb 180) (command "pline" PGmb21 PGmb24 "w" "1.0" "0" PGmb25 ""))

((or (and (> Gmb 180) (< Gmb 270)) (and (> Gmb 270) (< Gmb 360)))

(command "pline" PGmb21 PGmb2 PGmb26 "w" "1.0" "0" PGmb27 ""))

((= Gmb 270) (command "pline" PGmb31 PGmb32 PGmb33 "w" "1.0" "0" PGmb34 ""))

)

(setq V1 (1+ V1))

);endlambda

LisPTcoc LisPGmb LisPGmb1 LisPKc LisPho LisPmd LisPdo LisPss

LisTcoc LisGoc LisLkcdo LisHo Lismd Lisdo LisdeltaMD LisdeltaDO

);endmapcar (princ lis)

;-----

;draw two

(setq lisdd (cdr LisLkcd)

Pdd1 (polar Pddi a 2.5) Pdd2 (polar Pddi a 7) Pdd3 (polar Pddi a 10)

Pdd4 (polar Pddi a 5)

PKcd (polar Pta1 a 25)

)

(command "layer" "s" "manh" "" "line" pddi pdd3 "")

(setq V4 0)

(repeat (length Lisdd)

(setq

;parameter gradient

Pddi1 (polar Pddi 0 (- (nth V4 Lisdd) (nth V4 LisLkc)))

Pddi2 (polar Pdd3 0 (- (nth V4 Lisdd) (nth V4 LisLkc)))

Pddi3 (polar Pdd4 0 (- (nth V4 Lisdd) (nth V4 LisLkc)))

Pdd11 (polar Pdd1 0 (- (nth V4 Lisdd) (- (nth V4 LisLkc) 10)))

Pdd12 (polar Pdd1 0 (- (nth V4 Lisdd) 10))

Pdd21 (polar Pdd2 0 (- (nth V4 Lisdd) (- (nth V4 LisLkc) 10)))

Pdd22 (polar Pdd2 0 (- (nth V4 Lisdd) 10))

Pdd31 (polar Pdd3 0 (nth V4 Lisdd))

Pdd32 (polar Pddi 0 (nth V4 Lisdd))

Pdd41 (polar Pdd4 0 (nth V4 Lisdd))

PKcd1 (polar PKcd 0 (- (nth V4 Lisdd) (/ (nth V4 LisLkc) 2)))

)

(cond

((> (nth V4 Lisi) 0)

(command

"layer" "s" "manh" ""

"pline" Pddi2 Pdd32 Pdd31 ""

"layer" "s" "chuv" ""

"style" "chuv" "VNI-Helve-condense" "" "1" "" "" "" ""

"text" "j" "mc" PKcd1 3.0 0.0 (strcat (rtos (nth V4 LisLkco) 2 1) "m-"(nth VL LisVL))

"text" "j" "mc" Pdd11 2.5 0.0 (strcat "D" (rtos D 2 0))

"text" "j" "mc" Pdd22 2.5 0.0 (strcat "i=" (rtos (nth V4 Lisi) 2 4))))

((= (nth V4 Lisi) 0)

(command

"layer" "s" "manh" ""

"pline" Pddi3 Pdd41 Pdd31 Pdd32 ""

"layer" "s" "chuv" ""

"style" "chuv" "VNI-Helve-condense" "" "1" "" "" "" ""

"text" "j" "mc" PKcd1 3.0 0.0 (strcat (rtos (nth V4 LisLkco) 2 1) "m-"(nth VL LisVL))

"text" "j" "mc" Pdd11 2.5 0.0 (strcat "D" (rtos D 2 0))

"text" "j" "mc" Pdd22 2.5 0.0 (strcat "i=" (rtos (nth V4 Lisi) 2 4))))

((< (nth V4 Lisi) 0)

(command

"layer" "s" "manh" ""

"pline" Pddi1 Pdd31 Pdd32 ""

"layer" "s" "chuv" ""

"style" "chuv" "VNI-Helve-condense" "" "1" "" "" "" ""

"text" "j" "mc" PKcd1 3.0 0.0 (strcat (rtos (nth V4 LisLkco) 2 1) "m-"(nth VL LisVL))

"text" "j" "mc" Pdd12 2.5 0.0 (strcat "D" (rtos D 2 0))

"text" "j" "mc" Pdd21 2.5 0.0 (strcat "i=" (rtos (nth V4 Lisi) 2 4))))

)

(setq V4 (1+ V4))

)

;--draws ground and pipe bottom level line

(setq

LisPssd (reverse LisPssd)

LisPssd1 (append (cdr LisPssd) (car LisPssd))

LisPssdo (reverse LisPssdo)

LisPssdo1 (append (cdr LisPssdo) (car LisPssdo))

V2 0 V3 0

)

(repeat (- (length LisPssd) 1)

(command

"layer" "s" "manh" ""

"line" (nth V2 LisPssd) (nth V2 LisPssd1) ""

"layer" "s" "ong" ""

"line" (nth V2 LisPssdo) (nth V2 LisPssdo1) ""

)

(setq V2 (1+ V2))

)

(repeat 8

(setq Ptdao (polar Pta1 a 70)

Ptda1 (polar Ptdao c (* V3 10))

Ptda2 (polar Pss c (* V3 10)))

(command "layer" "s" "manh" "" "line" Ptda1 Ptda2 "")

(setq V3 (1+ V3))

);repeat

;--end draws ground and pipe bottom level line

(onap2)

);progn

);end function QQTD

;--------------------

[xnetlove 0]

:cheers: Chào các thành viên trong Diễn đàn CadViet. Pro nào có thể viết dùm mình líp: Vẽ nết cắt, cửa đi, cửa sổ mà sau khi thực hiện xong đối tượng đước gán về layer của riêng chúng (Thực ra lip này trên Diễn dàn cũng đã có nhưng chưa tự gán layer nên mất thời gian gán lại). Thank !

[Phiphi- 176]

Xin nhờ các Bác viết cho 1 đoạn LISP về Xref mẫu để PP sẽ tập viết tiếp.

 

a. Dùng lệnh Xref, mình có n bản vẽ dành cho Xref được lưu trong đường dẩn D:\ProjectA\Drawings\XREF

1. Đánh XbvA1 thì lệnh Xref sẽ Attach bản vẽ mặc định là bvA (filename sẽ khác) (1=on, 0=off) Khi attach vào b/v thì Draw order là Send to Back

2. Đánh XbvA0 thì lệnh Xref sẽ Detach bản vẽ mặc định là bvA ...Làm tương tư cho các b/v 1...n

3. Đánh XALL1 thì lệnh Xref sẽ Attach tất cả n bàn vẽ vào bv đang vẽ với mặc định: Insertion Point 0,0,0 - Scale: 1,1,1 - Rotate: 0d - Full path (1=on, 0=off)

4. Đánh XALL0 thì lệnh Xref sẽ Detach tất cả n bàn vẽ

 

b. Dùng lệnh Copy with Base point: Có 2 bản vẽ A và B

1. Đánh AB, lệnh Copy with Base point hoat động, LISP tự động đặt x=0, y=0

2. Select object ở bản vẽ A, Enter

3. Right click trên bản vẽ B để chọn lệnh Paste, enter

4. Object sẽ tự dộng nhập vảo bản vẽ B với Insertion point là x=0, y=0

 

Hai LISP trên có thể sử dụng để insert khung tên trong các Layout và ứng dụng nhiều việc khác nữa.

Xin cảm ơn nhiều.

Các Bác ơi, xin hãy giúp em với.

[Phidoi_gabay 14]

Các Bác ơi, xin hãy giúp em với.

Mình cũng hay dùng Xref. Nhưng để làm như PP thì mình không hiểu lắm. Nó giải quyết vấn đề j vậy ? Vì nếu khi Attach bạn để Renference Type là Attachment thì tất cả các bản xref có trong đó sẽ đi theo. Nếu bạn để Overlay thì chỉ bản vẽ đang Attach đi theo thôi. Bạn trước đó sẽ không đc đính kèm.

[Phiphi- 176]

Mình cũng hay dùng Xref. Nhưng để làm như PP thì mình không hiểu lắm. Nó giải quyết vấn đề j vậy ? Vì nếu khi Attach bạn để Renference Type là Attachment thì tất cả các bản xref có trong đó sẽ đi theo. Nếu bạn để Overlay thì chỉ bản vẽ đang Attach đi theo thôi. Bạn trước đó sẽ không đc đính kèm.

Cám ơn Bác đã quan tâm.

Vì trong 1 bản vẽ có nhiều Xref mà nếu có LISP để attach & detach những Xref nào cần thiết thì rất tiện. Bình thường thì phải dùng Xref manager để thực hiện.

Cũng giống như sử dụng nhiều Layer, nhiều khi ta phải turn on hoặc off những layer cần (hoặc không cần) thiết ngay trong khi vẽ, hiệu chỉnh cũng như in ra bản vẽ. Nếu có LISP thì chỉ cần đánh 1 lệnh nào đó, ta có thể control mọi layers, Xref files trong nháy mắt.

Một điều cần nói là việc sử dung Xref sẽ làm bản vẽ trở nên nhẹ (ít KB) việc open bản vẽ nhanh hơn, làm việc cũng nhanh hơn vì LISP sẽ giúp ta turn off những layers, images, Xref không cần thiết.

[Phidoi_gabay 14]

Vơi những bản chỉ mang tính chất Reference thì mình luôn Purge những layer không cần thiết đi. Việc đó cũng làm giảm dung lượng đáng kể. Hơn nữa bản vẽ dùng làm Renference có thể sẽ phải turn off các layer trong bản vẽ đó đi. Việc này cũng thao tác khá đơn giản trong Xref mà. Mình nói ở đây không phải vì tranh luận cái đúng của mình nhé! vì mình chỉ muốn biết cái lợi mà bạn muốn có khi sử dụng list thôi. he he !!

[dvdcad 1]

các bác viết giúp lisp này

 

có 1 lisp có lệnh 200 (tỷ lệ bản vẽ 1/200)

thì hiện lên như thế này

[duy782006 1.549]

các bác viết giúp lisp này

 

có 1 lisp có lệnh 200 (tỷ lệ bản vẽ 1/200)

thì hiện lên như thế này

 

(setvar "MODEMACRO" "noi dung dong chu")

Cứ ưng hiện lên chữ gì thì thay bằng chữ đó

[dvdcad 1]

(setvar "MODEMACRO" "noi dung dong chu")

Cứ ưng hiện lên chữ gì thì thay bằng chữ đó

 

cám ơn bạn nhé

nhưng mình muốn khi mình thay lệng 500 or 1000 (VD 1/500 or 1/1000)

thì nó cũng thay đổi theo

[bighead 16]

Gửi bác Hoành.

Em không rành về lisp và chẳng biết tẹo nào về VBA for Cad. Nhưng nhu cầu công việc hiện tại em cần là triển khai bản vẽ thi công. Ngặt cái là file do bên A gửi qua đều là minsert objects. Em cần là phá khối và khai thác bản vẽ tối đa, 100% thì tốt. Với tầm hiểu biết của em thì chỉ lấy được 60% thôi. Mày mò tìm kiếm thì có hai code sau:

xminsert

code VBA for exploding minsert objects

 

Vấn đề là : em chẳng biết cách dùng code VBA ! code lisp thì không chạy ! Chắc hẳn bác đã biết đến 2 đoạn mã này, vậy mong bác chỉ giúp.

Đây là file mẫu đã bị khóa.

 

Trên diễn đàn đã có chủ đề khóa files bằng nhiều cách. Nên em gửi yêu cầu này không biết có mâu thuẫn với anh em hay không ! Nếu có mong anh em bỏ qua và bác Admin hãy xóa bài này nếu thấy cần!

 

Mong được học hỏi thêm ! Bác có thể pm theo bigheaddemon2003@yahoo.com

[Nguyen Hoanh 4.663]

Gửi bác Hoành.

Em không rành về lisp và chẳng biết tẹo nào về VBA for Cad. Nhưng nhu cầu công việc hiện tại em cần là triển khai bản vẽ thi công. Ngặt cái là file do bên A gửi qua đều là minsert objects. Em cần là phá khối và khai thác bản vẽ tối đa, 100% thì tốt. Với tầm hiểu biết của em thì chỉ lấy được 60% thôi. Mày mò tìm kiếm thì có hai code sau:

xminsert

code VBA for exploding minsert objects

 

Vấn đề là : em chẳng biết cách dùng code VBA ! code lisp thì không chạy ! Chắc hẳn bác đã biết đến 2 đoạn mã này, vậy mong bác chỉ giúp.

Đây là file mẫu đã bị khóa.

 

Trên diễn đàn đã có chủ đề khóa files bằng nhiều cách. Nên em gửi yêu cầu này không biết có mâu thuẫn với anh em hay không ! Nếu có mong anh em bỏ qua và bác Admin hãy xóa bài này nếu thấy cần!

 

Mong được học hỏi thêm ! Bác có thể pm theo bigheaddemon2003@yahoo.com

Explode Minsert thì làm được bằng nhiều cách.

 

Nhưng nếu chỉ giúp bạn cách mở khóa 1 file mà người ta đã khóa thì tôi áy náy quá (nhỡ may người khóa đó lại là thành viên CADViet thì sao?)

 

Đang giằng xé lương tâm quá, mọi người cho ý kiến thêm.

 

Còn về cách dùng code VBA thì chương trình nào cũng vậy, bất kể Word, Excel, ACAD,... đều giống nhau:

- Bạn nhấn Ctr+F11 để hiện cửa sổ Visual Basic for Application.

- Vào menu Insert > Module để tạo mới một module. Paste code VBA vào đó.

- Quay ngược trở lại AutoCAD, nhấn Ctr+F8, chọn tên hàm rồi Run.

[bighead 16]

 

Cám ơn bác Hoành đã tận tình hướng dẫn nhưng kết quả vẫn không như ý! Chỉ phá được một layer thôi, chẳng hiểu làm sao nữa !

 

File này là do bên A giao, của DCMSTUDIOS tư vấn thiết kế kiến trúc. Nghe đâu ở bên Hồng Kông. Em nghĩ nhu cầu thì mỗi người mỗi khác, muôn hình vạn trạng. Bác có thể gợi mở thêm không? Nếu không thì em đành tiếp tục "bơi" vậy, hy vọng sẽ tìm ra trước khi kết thúc công trình !?!?!

'"

À, tiện thể bác cho em hỏi. Dùng lệnh flatten đối với block này, trả lời "Y" thì máy báo "Unreference block found", còn trả lời "N" thì ... treo CAD và máy thì cũng treo lủng lẳng luôn ! Căn nguyên là sao vậy bác ?

[duy782006 1.549]

Explode Minsert thì làm được bằng nhiều cách.

 

Nhưng nếu chỉ giúp bạn cách mở khóa 1 file mà người ta đã khóa thì tôi áy náy quá (nhỡ may người khóa đó lại là thành viên CADViet thì sao?)

 

Đang giằng xé lương tâm quá, mọi người cho ý kiến thêm.

 

Còn về cách dùng code VBA thì chương trình nào cũng vậy, bất kể Word, Excel, ACAD,... đều giống nhau:

- Bạn nhấn Ctr+F11 để hiện cửa sổ Visual Basic for Application.

- Vào menu Insert > Module để tạo mới một module. Paste code VBA vào đó.

- Quay ngược trở lại AutoCAD, nhấn Ctr+F8, chọn tên hàm rồi Run.

convert anonymous block to normal block

Bạn tìm với dòng trên bác Hoành có lisp làm việc này thì phải.