Viết Lisp theo yêu cầu

[Tue_NV 3.912]

Chào Tue_NV khoảng cách bước nhảy P ở đây là 328.6 đã được làm tròn, khoảng cách P lúc đầu do mình chọn ngẫu nhiên lisp sẽ tính cho ta số gần đúng và làm tròn đoạn mã lúc đầu mình gửi bạn có thể test, đoạn mã lúc đầu của mình đẵ thỏa được phần tính toán chủ yếu mình muốn nhờ các bạn sửa giúp để cải thiện công việc mình chỉ cần Pick...Pick và Pick để cho ra kết quả để hạn chế sai sót lúc đầu khi tính toán mình copy trong dòng command rồi dán vô trong những lúc thao tác nhanh có thể dán vô còn sót lại nội dung củ :lol2: để hạn chế lỗi đó mình chỉ còn cách cầu cứu các bạn thui. Cám ơn đã đọc và quan tâm :lol2: Ok

Có lẽ các bạn ngạc nhiên khi thấy bước vít của mình có số lẽ trong đó vì những tấm kim loại của mình khi gia công đục lỗ sử dụng máy tự động chỉ cần lập trình thi nó cứ pan pan & pan cho đến hết.

Tue_NV không hiểu câu bạn nói là : với số P tuỳ ý thì Lisp sẽ tính toán ra con số hợp lý?

Vậy con số nào là con số hợp lý???? và hợp lý như thế nào? Bạn nói vầy chỉ có mình bạn hiểu mà thôi

Tue_NV đã viết đoạn Lissp này. Nếu có gì chưa được hãy post lên đây và nói rõ

 

(defun c:Tdim()

 

(setq L (getreal "\n Nhap so L = hoac Enter de chon DIMENSION chieu dai : "))

(setq Ltinh L)

 

(if (null L)

(progn

(setq L (car(entsel "\nChon kich thuoc chieu dai : ")))

 

(setq ent (entget L))

 

(if (= (cdr(assoc 1 ent)) "")

(setq Ltinh (cdr(assoc 42 ent)))

(setq Ltinh (atof(cdr(assoc 1 ent))))

)

)

)

 

(setq A (getreal "\n Nhap so A = hoac Enter de chon DIMENSION chieu dai : "))

(setq Atinh A)

 

(if (null A)

(progn

(setq A (car(entsel "\nChon kich thuoc chieu dai : ")))

 

(setq entt (entget A))

 

(if (= (cdr(assoc 1 entt)) "")

(setq Atinh (cdr(assoc 42 entt)))

(setq Atinh (atof(cdr(assoc 1 entt))))

)

)

)

(setq P (getreal "\n Nhap khoang cach buoc nhay :"))

(setq n (/ (- Ltinh (* 2 Atinh)) P))

(setq Di (entget(car(entsel "\n Pick chon Dim can xuat ket qua :"))))

(entmod (subst(cons 1 (strcat "@=" (rtos P 2 2) "x" (rtos n 2 0))) (assoc 1 Di) Di))

 

(prompt (strcat "\n" (rtos Atinh 2 0) " + " (rtos P 2 2) "x" (rtos n 2 0) " + " (rtos Atinh 2 0)))

(princ)

)

[shinnikel 1]

Tue_NV không hiểu câu bạn nói là : với số P tuỳ ý thì Lisp sẽ tính toán ra con số hợp lý?

Vậy con số nào là con số hợp lý???? và hợp lý như thế nào? Bạn nói vầy chỉ có mình bạn hiểu mà thôi

Tue_NV đã viết đoạn Lissp này. Nếu có gì chưa được hãy post lên đây và nói rõ

 

Chào Tue_NV để mình giải thích chút về P trong công việc của mình P có rất nhiều giá trị chuẩn nếu bước vít có thể nhìn thấy giao động từ 300 trở xuống bước vít không nhìn thấy đầu vít thì khoảng 350 còn 1 số loại tacke bắt vào tường khoảng 500. Lisp mới bạn viết cho mình các bước thực hiện rất ok chỉ có điều kết quả tính toán không đúng ví dụ với lisp bạn viết mình test như sau: với L=2500 , A=100 , P=350(đây là bước vít không nhìn thấy) kết quà tính toán của bạn sẽ là @=350x7 nếu lấy các con số A+@=Pxn+A =2650 khác với L ban đầu là 2500 còn lisp ban đầu của mình sẽ cho kết quả là @=328.6×7 cộng các con số lại sẽ được L=2500.2 gần giống với L ban đầu. Trình tự đục lỗ tự động như sau người thợ sẽ lấy dấu từ mép nhập A=100 , @=328.6×7 máy sẽ tự động chạy dao tiến vào 100 rồi đụt 1 phát sau đó chay tiếp 328.6 đụt 1 phát nữa và cứ thế tiếp tục 6 phát nữa rồi lấy sp ra. Bạn xem file của mình nha: file minh hoa nhờ bạn hoàn thiện dùm chân thành cám ơn. :lol2:

[Tue_NV 3.912]

Chào Tue_NV để mình giải thích chút về P trong công việc của mình P có rất nhiều giá trị chuẩn nếu bước vít có thể nhìn thấy giao động từ 300 trở xuống bước vít không nhìn thấy đầu vít thì khoảng 350 còn 1 số loại tacke bắt vào tường khoảng 500. Lisp mới bạn viết cho mình các bước thực hiện rất ok chỉ có điều kết quả tính toán không đúng ví dụ với lisp bạn viết mình test như sau: với L=2500 , A=100 , P=350(đây là bước vít không nhìn thấy) kết quà tính toán của bạn sẽ là @=350x7 nếu lấy các con số A+@=Pxn+A =2650 khác với L ban đầu là 2500 còn lisp ban đầu của mình sẽ cho kết quả là @=328.6×7 cộng các con số lại sẽ được L=2500.2 gần giống với L ban đầu. Trình tự đục lỗ tự động như sau người thợ sẽ lấy dấu từ mép nhập A=100 , @=328.6×7 máy sẽ tự động chạy dao tiến vào 100 rồi đụt 1 phát sau đó chay tiếp 328.6 đụt 1 phát nữa và cứ thế tiếp tục 6 phát nữa rồi lấy sp ra. Bạn xem file của mình nha: file minh hoa nhờ bạn hoàn thiện dùm chân thành cám ơn. :lol2:

Chào shinnikel

Lisp đây. Tue_NV đã sửa lại rồi. Hy vọng đúng ý bạn

Chú ý rằng Lisp chấp nhận cả Dim độ chế, nhưng với loại Dim này chỉ tính đối với Dim số, chứ với Dim có cả chữ và số thì nó không tính được như ý của mình. Ví dụ như Dim L=2500 (có cả chữ và số) thì sẽ ra kết quả không như ý. Dim 2500 thì tính đúng ý mình.

 

(defun c:Tdim()

(setq oldim (getvar "DimZin"))

(setvar "Dimzin" 0)

(setq L (getreal "\n Nhap so L = hoac Enter de chon DIMENSION chieu dai : "))

(setq Ltinh L)

 

(if (null L)

(progn

(setq L (car(entsel "\nChon kich thuoc chieu dai : ")))

 

(setq ent (entget L))

 

(if (= (cdr(assoc 1 ent)) "")

(setq Ltinh (cdr(assoc 42 ent)))

(setq Ltinh (atof(cdr(assoc 1 ent))))

)

)

)

 

(setq A (getreal "\n Nhap so A = hoac Enter de chon DIMENSION chieu dai : "))

(setq Atinh A)

 

(if (null A)

(progn

(setq A (car(entsel "\nChon kich thuoc chieu dai : ")))

 

(setq entt (entget A))

 

(if (= (cdr(assoc 1 entt)) "")

(setq Atinh (cdr(assoc 42 entt)))

(setq Atinh (atof(cdr(assoc 1 entt))))

)

)

)

(setq Pt (getreal "\n Nhap khoang cach buoc nhay :"))

(setq n (atof(rtos(/ (- Ltinh (* 2 Atinh)) Pt) 2 0)))

(setq P (/ (- Ltinh (* 2 Atinh)) n))

 

(setq Di (entget(car(entsel "\n Pick chon Dim can xuat ket qua :"))))

(entmod (subst(cons 1 (strcat "@=" (rtos P 2 2) "x" (rtos n 2 0))) (assoc 1 Di) Di))

 

(prompt (strcat "\n" (rtos Atinh 2 0) " + " (rtos P 2 2) "x" (rtos n 2 0) " + " (rtos Atinh 2 0)))

(setvar "Dimzin" oldim)

(princ)

)

:lol2:

[shinnikel 1]

Cám ơn Tue_NV bạn rất nhiệt tình còn vấn đề L= mình nghĩ có thể giải quyết được bạn có thể sửa kết quả lại để làm tròn 1 số không hiện tại bạn đang cho làm tròn tới 2 số, nếu kết quả ra .00 bạn có thể bỏ luôn cho mình có được không bao giờ bạn rảnh sửa giúp mình cũng được chúc bạn và mọi ngươi ngủ ngon mai phải bắt đầu cài rôi hihi.. :lol2:

[Tue_NV 3.912]

Cám ơn Tue_NV bạn rất nhiệt tình còn vấn đề L= mình nghĩ có thể giải quyết được bạn có thể sửa kết quả lại để làm tròn 1 số không hiện tại bạn đang cho làm tròn tới 2 số, nếu kết quả ra .00 bạn có thể bỏ luôn cho mình có được không bao giờ bạn rảnh sửa giúp mình cũng được chúc bạn và mọi ngươi ngủ ngon mai phải bắt đầu cài rôi hihi.. :lol2:

"Việc hôm nay chớ để đến ngày mai "

(defun c:Tdim()

(setq oldim (getvar "DimZin"))

(setvar "Dimzin" 0)

(setq L (getreal "\n Nhap so L = hoac Enter de chon DIMENSION chieu dai : "))

(setq Ltinh L)

 

(if (null L)

(progn

(setq L (car(entsel "\nChon kich thuoc chieu dai : ")))

 

(setq ent (entget L))

 

(if (= (cdr(assoc 1 ent)) "")

(setq Ltinh (cdr(assoc 42 ent)))

(setq Ltinh (atof(cdr(assoc 1 ent))))

)

)

)

 

(setq A (getreal "\n Nhap so A = hoac Enter de chon DIMENSION chieu dai : "))

(setq Atinh A)

 

(if (null A)

(progn

(setq A (car(entsel "\nChon kich thuoc chieu dai : ")))

 

(setq entt (entget A))

 

(if (= (cdr(assoc 1 entt)) "")

(setq Atinh (cdr(assoc 42 entt)))

(setq Atinh (atof(cdr(assoc 1 entt))))

)

)

)

(setq Pt (getreal "\n Nhap khoang cach buoc nhay :"))

(setq tp (getint "\n So chu so thap phan :"))

(setq n (atof(rtos(/ (- Ltinh (* 2 Atinh)) Pt) 2 0)))

(setq P (/ (- Ltinh (* 2 Atinh)) n))

 

(setq Di (entget(car(entsel "\n Pick chon Dim can xuat ket qua :"))))

(entmod (subst(cons 1 (strcat "@=" (rtos P 2 tp) "x" (rtos n 2 0))) (assoc 1 Di) Di))

 

(prompt (strcat "\n" (rtos Atinh 2 0) " + " (rtos P 2 tp) "x" (rtos n 2 0) " + " (rtos Atinh 2 0)))

(setvar "Dimzin" oldim)

(princ)

)

[khanhduydang 8]

http://www.cadviet.com/upfiles/THETICH.lsp

 

Mình sử dụng lisp này để tính thể tích khối Solid. Nhưng khi dùng lisp cho scale khối đó theo 1 phương thì thể tính thể tích bằng lisp đó được nữa.

Cụ thể:

1. Mình có 1 hình hộp

2. Mình tính được thể tích bình thường khi extrude xong bằng lisp theo link trên.

3. Sau đó mình dùng scale 1 phương (cũng bằng lisp) có trên diễn đàn cadviet mình.

4. Cuối cùng là không còn tính được thể tích nữa.

Hic hic nhờ các bác giúp dùm.

:lol2: Xin cám ơn các bác trước nha. Mình mô tả vậy chắc rõ ràng phải không?

[shinnikel 1]

Tue_NV[/color]' date='Jun 14 2009, 22:29' post='64210']

"Việc hôm nay chớ để đến ngày mai "

Chào buổi sáng như vậy Lisp mình đã được cải tiến rồi Thanks. :lol2:

[hauhn 0]

Chào các bạn. Mình load trên CAD việt 1 lisp nâng cốt đồng mức lên 1 cao độ Z nhất định để khôi phục bình đồ chạy HS. lisp rất hay, tuy nhiên mình muốn nhờ các bạn sửa giúp mình 1 chút.

Trong bản bình đồ đã bị phá các đường đồng mức bị phá thành các đoạn cùng cao độ. lisp yêu cầu mình nhập liên tục các đồng mức vì vậy muốn nhập phải mất công nối các đường này lại. việc này với bình đồ nhỏ thì không vấn đề gì nhưng với bình đồ lớn là khá mất thời gian. Mình muốn nhờ bạn sửa lại thành cho phép chọn nhiều đường đồng mức cùng lúc.

thứ 2, mình đã có 1 lisp nâng cốt từ text hay nói cách khác mình có thể đọc được giá trị value của text gán cho Z.

mình muốn sửa đổi lisp đồng mức thành 2 tùy chọn là nhập giá trị Z cho đường đồng mức hoặc chọn text và gán giá trị đó thay cho việc nhập.

Mình mới học về lisp nên chỉnh code của lisp đồng mức toàn bị loạn lên và báo lỗi ko chạy được. nhờ các bạn sửa giúp mình, thanks.

http://www.cadviet.com/upfiles/Dia_hinh_chay_HS.rar

http://www.cadviet.com/upfiles/dong_muc_1.lsp

http://www.cadviet.com/upfiles/Movet.lsp

[conghoan1003 0]

Hôm trước mình thấy trên diễn đàn có lệnh sắp xếp text rất hay nhưng chỉ sắp xếp theo lề trái. Bác nào giùp mình "nâng cấp" nó lên thành sắp xếp theo lề trái, lề phải, hay canh giữa tuỳ mình chọn.

Khi mình chạy lisp thì chương trình sẽ hỏi: bạn muốn canh trái, canh phải, hay canh giữa.

Sau đó chọn các text cần sắp xếp, rồi ấn enter. (dòng text tự động sắp xếp theo text trên cùng)

Rồi tiếp tục chọn các text tiếp theo rồi enter.

Thank!

đây là code hôm trước mình tìm được các bạn tham khảo nha.

(defun c:st1()

(setq oldos (getvar "osmode"))

(setvar "osmode" 0)

(setq ss (ssget '((0 . "TEXT")))

lst (ss2ent ss)

lst (vl-sort lst

'(lambda (e1 e2)

(>

(caddr (assoc 10 (entget e1)))

(caddr (assoc 10 (entget e2)))

)

)

)

)

 

(setq ddau (cdr(assoc 10 (entget(car lst))))

i 0)

 

(foreach e lst

(setq ent (entget e))

(setq dcuoi (cdr(assoc 10 ent)))

(setq ddauu (list (car ddau) (cadr dcuoi) 0))

(command "move" e "" dcuoi ddauu)

(setq i (1+ i))

)

(setvar "osmode" oldos)

(Princ)

)

 

(defun ss2ent (ss / sodt index lstent)

(setq

sodt (if ss (sslength ss) 0)

index 0

)

(repeat sodt

(setq ent (ssname ss index)

index (1+ index)

lstent (cons ent lstent)

)

)

(reverse lstent)

)

Ai biết giúp mình với!

[gia_bach 1.549]

Chào các bạn. Mình load trên CAD việt 1 lisp nâng cốt đồng mức lên 1 cao độ Z nhất định để khôi phục bình đồ chạy HS. lisp rất hay, tuy nhiên mình muốn nhờ các bạn sửa giúp mình 1 chút.

Trong bản bình đồ đã bị phá các đường đồng mức bị phá thành các đoạn cùng cao độ. lisp yêu cầu mình nhập liên tục các đồng mức vì vậy muốn nhập phải mất công nối các đường này lại. việc này với bình đồ nhỏ thì không vấn đề gì nhưng với bình đồ lớn là khá mất thời gian. Mình muốn nhờ bạn sửa lại thành cho phép chọn nhiều đường đồng mức cùng lúc.

thứ 2, mình đã có 1 lisp nâng cốt từ text hay nói cách khác mình có thể đọc được giá trị value của text gán cho Z.

mình muốn sửa đổi lisp đồng mức thành 2 tùy chọn là nhập giá trị Z cho đường đồng mức hoặc chọn text và gán giá trị đó thay cho việc nhập.

Mình mới học về lisp nên chỉnh code của lisp đồng mức toàn bị loạn lên và báo lỗi ko chạy được. nhờ các bạn sửa giúp mình, thanks.

http://www.cadviet.com/upfiles/Dia_hinh_chay_HS.rar

http://www.cadviet.com/upfiles/dong_muc_1.lsp

http://www.cadviet.com/upfiles/Movet.lsp

Chào hauhn

LISP đã sửa theo ỵêu cầu của bạn.

;------------------------------------
;---- Nang Text 3D for SDSK----------
;------------------------------------
(defun c:movet (/ ss ee cd p newVal)
 (command "UNDO" "begin")
 (if (setq ss (ssget '((0 . "TEXT"))))
   (foreach ee (mapcar 'entget (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (setq p (cdr (assoc 10 ee) )
    cd (cdr (assoc 1 ee))
    newVal (getreal (strcat "\nNhap cao do <" cd "> :")) )
     (if newVal
(setq p (list (car p) (cadr p) newVal ) )
(setq p (list (car p) (cadr p) (atof cd) ) )
)
     (entmod (subst (cons 10 p) (assoc 10 ee) ee))
     )
   )
 (command "UNDO" "end")   
)
;---------------------------------------
;---- Set cao do cho duong dong muc ----
;---------------------------------------
(defun c:GDM (/ ss e caodo buoc)
 (vl-load-com)
 (command "UNDO" "begin")
 (if (not (tblsearch "LAYER" "DM_so_hoa"))
   (command "-layer" "n" "DM_so_hoa" "c" "1" "DM_so_hoa" "")
   )
 (or *caodo* (setq *caodo* 50.0))
 (or *buoc* (setq *buoc* 0.5))
 (setq caodo (getreal (strcat"\nNhap cao do ban dau cua duong dong muc <" (rtos *caodo*) ">:"))
buoc (getreal (strcat"\nNhap chenh cao giua cac duong dong muc <" (rtos *buoc*) ">:"))
)
 (if buoc (setq *buoc* buoc) (setq buoc *buoc*))
 (if caodo (setq *caodo* caodo) (setq caodo *caodo*))
 (while
   (and
     (princ (strcat "\nChon duong dong muc cho cao do <" (rtos caodo 2 2) "> / Enter de ket thuc"))
     (setq ss (ssget (list (cons 0 "*POLYLINE") (cons 8 "~DM_so_hoa"))))
     )
   (foreach e (mapcar 'vlax-ename->vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (if (vlax-property-available-p e 'Elevation)
(progn
  (vla-put-Elevation e caodo)
  (vla-put-Layer e "DM_so_hoa")
  )
)
     )
   (setq caodo (+ caodo buoc)
  *caodo* caodo)
   )
 (command "UNDO" "end")   
)

[q288 166]

Hôm trước mình thấy trên diễn đàn có lệnh sắp xếp text rất hay nhưng chỉ sắp xếp theo lề trái. Bác nào giùp mình "nâng cấp" nó lên thành sắp xếp theo lề trái, lề phải, hay canh giữa tuỳ mình chọn.

Khi mình chạy lisp thì chương trình sẽ hỏi: bạn muốn canh trái, canh phải, hay canh giữa.

Sau đó chọn các text cần sắp xếp, rồi ấn enter. (dòng text tự động sắp xếp theo text trên cùng)

Rồi tiếp tục chọn các text tiếp theo rồi enter.

Ai biết giúp mình với!

 

Bạn xài cái này thử xem.

(defun tdchen(ent / k eget dchen)
  (setq k (cdr (assoc 72 (setq eget (entget ent))))									 
 dchen (if (zerop k)             
	(cdr (assoc 10 eget))
               (cdr (assoc 11 eget)))
  )	
  dchen			  
)

(defun c:st1 ( / oldos lst1 ss ki ki1 lst ddau dcuoi eget)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (setq lst1 '(("L" acAlignmentLeft)
      ("C" acAlignmentCenter)
      ("R" acAlignmentRight)
      ("M" acAlignmentMiddle )
      ("TL" acAlignmentTopLeft)
      ("TC" acAlignmentTopCenter)
      ("TR" acAlignmentTopRight)
      ("ML" acAlignmentMiddleLeft )
      ("MC" acAlignmentMiddleCenter)
      ("MR" acAlignmentMiddleRight)
      ("BL" acAlignmentBottomLeft)
      ("BC" acAlignmentBottomCenter )
      ("BR" acAlignmentBottomRight )))

 (prompt "Chon Text:")
 (setq ss  (ssget '((0 . "TEXT"))))

 (initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
 (setq ki  (getkword "Enter an option [Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:")
ki1 (eval (cadr (assoc ki lst1)))        
lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) 
                                     (caddr (assoc 10 (entget e2))))))										 
ddau (car (tdchen (car lst)))								 
 )

 (command "undo" "begin")
 (foreach e lst   
(setq eget (entget e)
      dcuoi (cons ddau (cdr (tdchen e))) 
      eget (subst (cons 72 ki1) (assoc 72 eget) eget)
      eget (if (zerop ki1)
	         (subst (cons 10 dcuoi) (assoc 10 eget) eget)
		 (subst (cons 11 dcuoi) (assoc 11 eget) eget))
)	
   (entmod eget)  
 )
 (command "undo" "end")
 (setvar "osmode" oldos)
 (Princ)
)

[LeMai 12]

Mình hok bít bạn căn lề để làm gì? Mình thấy khi đánh lệnh T đã hiện ra bảng text formating

có chức năng left, right, top, middle, bottom.

[q288 166]

Sorry, mình quên text align có 2 dxf code là 72 và 73. Mình sửa lại như sau.

(defun tdchen(ent / k1 k2 eget dchen)
  (setq k1 (cdr (assoc 72 (setq eget (entget ent))))
 k2 (cdr (assoc 73  eget ))
 dchen (if (and (zerop k1) (zerop k2))            
	   (cdr (assoc 10 eget))
                  (cdr (assoc 11 eget)))
  )	
  dchen			  
)

(defun c:st1 ( / oldos lst1 ss ki ki0 ki1 ki2 lst ddau dcuoi eget)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (setq lst1 '(("L" 0 0)  ("C" 1 0)  ("R" 2 0)  ("M" 4 0)
      ("TL" 0 3)  ("TC" 1 3) ("TR" 2 3)
      ("ML" 0 2)  ("MC" 1 2) ("MR" 2 2)
      ("BL" 0 1)  ("BC" 1 1) ("BR" 2 1)))

 (prompt "Chon Text:")
 (setq ss  (ssget '((0 . "TEXT"))))

 (initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
 (setq ki  (getkword "Enter an option [Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:")
ki1 (cadr (setq ki0 (assoc ki lst1)))
       ki2 (last ki0)
       lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) 
                                     (caddr (assoc 10 (entget e2))))))										 
ddau (car (tdchen (car lst)))								 
 )

 (command "undo" "begin")
 (foreach e lst   
(setq eget (entget e)
      dcuoi (cons ddau (cdr (tdchen e))) 
      eget (subst (cons 72 ki1) (assoc 72 eget) eget)
      eget (subst (cons 73 ki2) (assoc 73 eget) eget)
      eget (if (and (zerop ki1) (zerop ki2))
	         (subst (cons 10 dcuoi) (assoc 10 eget) eget)
		 (subst (cons 11 dcuoi) (assoc 11 eget) eget))
)	
   (entmod eget)  
 )
 (command "undo" "end")
 (setvar "osmode" oldos)
 (Princ)
)

[q288 166]

Mình hok bít bạn căn lề để làm gì? Mình thấy khi đánh lệnh T đã hiện ra bảng text formating

có chức năng left, right, top, middle, bottom.

 

Nếu bạn cần gióng vài chục chữ cho thẳng hàng thì bạn dùng lệnh gì?

[hauhn 0]

cảm ơn bạn đã sửa giúp mình. khá ổn rồi đó, mình nhờ bạn chỉnh thêm 1 chút nữa đc ko.

mình muốn nó thực hiện giống cái movet cũ có nghĩa là click chọn text và đọc lấy giá trị của text đó làm giá trị cao độ sẽ nhập cho đường đồng mức ( có nghĩa thay vì nhập tay cao độ vào mình sẽ click chọn cái text có sẵn hoặc nhập tay giá trị này)

mình đã dựa trên lisp bạn chỉnh sửa để sửa thêm 1 chút là cho phép nhập chênh cao thay đổi trong quá trình chọn đường. đã khá ổn rồi bạn à. bạn xem giúp mình nhé , cảm ơn nhiều.

 

http://www.cadviet.com/upfiles/movet_gdm.rar

Chỉnh sửa Tháng 6 18, 2009 theo hauhn

[gia_bach 1.549]

cảm ơn bạn đã sửa giúp mình. khá ổn rồi đó, mình nhờ bạn chỉnh thêm 1 chút nữa đc ko.

mình muốn nó thực hiện giống cái movet cũ có nghĩa là click chọn text và đọc lấy giá trị của text đó làm giá trị cao độ sẽ nhập cho đường đồng mức ( có nghĩa thay vì nhập tay cao độ vào mình sẽ click chọn cái text có sẵn hoặc nhập tay giá trị này)

mình đã dựa trên lisp bạn chỉnh sửa để sửa thêm 1 chút là cho phép nhập chênh cao thay đổi trong quá trình chọn đường. đã khá ổn rồi bạn à. bạn xem giúp mình nhé , cảm ơn nhiều.

.....

Chào hauhn

LISP đã cập nhật theo ỵêu cầu của bạn.

Trường hợp bạn chọn TEXT cao độ thì việc nhập độ chênh cao là không cần thiết.

(defun c:GDM (/ ss e ent caodo newVal)
 (vl-load-com)
 (command "UNDO" "begin")
 (if (not (tblsearch "LAYER" "DM_so_hoa"))
   (command "-layer" "n" "DM_so_hoa" "c" "1" "DM_so_hoa" "")
   )
 (while
   (and
     (princ (strcat "\nChon duong dong muc / Enter de ket thuc"))
     (setq ss (ssget (list (cons 0 "*POLYLINE") (cons 8 "~DM_so_hoa"))))
     )
   (while
     (not
(and
  (setq ent (car (entsel "\nChon Text cao do : ")))
  (if ent (= (cdr (assoc 0 (entget ent))) "TEXT") )
  )
)
     (princ "\nChon lai : ")
     )
   (setq caodo (cdr (assoc 1 (entget ent)))
  newVal (getreal (strcat "\nNhap cao do <" caodo "> :")) )
   (if newVal (setq caodo newVal) (setq caodo (atof caodo)))
   (foreach e (mapcar 'vlax-ename->vla-Object (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss))))
     (if (vlax-property-available-p e 'Elevation)
(progn
  (vla-put-Elevation e caodo)
  (vla-put-Layer e "DM_so_hoa")
  )
)
     )    
   )
 (command "UNDO" "end")   
)

[xuantran15 112]

Chào các bác, :lol2:

Mình có 1 vấn đề cần nhờ các bác. Mình có một đường Polyline với nhiều đoạn cong, tại các đoạn cong có các góc đo khác nhau. Nhờ các bác viết cho mình một cái lisp mà khi thực hiện lệnh thì nó sẽ cho ra kết quả là góc tại điểm gấp khúc và khoảng cách từ điểm đó đến điểm đầu của PL. Mình mô tả cụ thể như sau:

 

1/ gõ lệnh và enter

2/ pick chọn đối tượng PL

Sau khi chọn đối tượng PL lisp sẽ thực hiện việc tính toán cho n điểm gấp khúc để cho ra kết quả là: n Góc trong (Góc nhỏ hơn) tại chổ gấp khúc trên PL S=AđộB'C", và cho biết khoảng cách từ điểm đó đến điểm đầu của PL là bao nhiêu đơn vị (L=bao nhiêu hoặc Kn+xyz).

3/ Các giá trị tính toán được tự động chèn vào đúng chổ tại điểm gấp khúc trên PL

4/ Kiểu Text, độ lớn text lấy theo Texstyle hiện hành.

Mong được sự giúp đỡ của các bác. :lol2:

[xinh75 0]

Mình muốn thay các chuỗi text trong bản vẽ

Ví dụ : Nguyễn Văn A thay bằng Trương B

Khối lượng thay bằng Quantity

Chiều dài thay bằng Length

........................................................

 

Mình muốn lập 1 file lisp như lệnh find của cad

 

Mỗi lần load đánh lệnh này thì nó sẽ tự động thay các string cũ bằng các string mới được định nghĩa trong file lisp

Module thay string cũ bằng string mới có thể để cuối cùng để có thể định nghĩa thêm các chuỗi mới.

 

Vì có nhiều bản vẽ nên mình không muốn mỗi lần mở file lại find và copy, paste từng chuỗi 1

 

Cám ơn các bạn

[Phiphi- 176]

Bạn xài cái này thử xem.

(defun tdchen(ent / k eget dchen)
  (setq k (cdr (assoc 72 (setq eget (entget ent))))									 
 dchen (if (zerop k)             
	(cdr (assoc 10 eget))
               (cdr (assoc 11 eget)))
  )	
  dchen			  
)

(defun c:st1 ( / oldos lst1 ss ki ki1 lst ddau dcuoi eget)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)
 (setq lst1 '(("L" acAlignmentLeft)
      ("C" acAlignmentCenter)
      ("R" acAlignmentRight)
      ("M" acAlignmentMiddle )
      ("TL" acAlignmentTopLeft)
      ("TC" acAlignmentTopCenter)
      ("TR" acAlignmentTopRight)
      ("ML" acAlignmentMiddleLeft )
      ("MC" acAlignmentMiddleCenter)
      ("MR" acAlignmentMiddleRight)
      ("BL" acAlignmentBottomLeft)
      ("BC" acAlignmentBottomCenter )
      ("BR" acAlignmentBottomRight )))

 (prompt "Chon Text:")
 (setq ss  (ssget '((0 . "TEXT"))))

 (initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
 (setq ki  (getkword "Enter an option [Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:")
ki1 (eval (cadr (assoc ki lst1)))        
lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) 
                                     (caddr (assoc 10 (entget e2))))))										 
ddau (car (tdchen (car lst)))								 
 )

 (command "undo" "begin")
 (foreach e lst   
(setq eget (entget e)
      dcuoi (cons ddau (cdr (tdchen e))) 
      eget (subst (cons 72 ki1) (assoc 72 eget) eget)
      eget (if (zerop ki1)
	         (subst (cons 10 dcuoi) (assoc 10 eget) eget)
		 (subst (cons 11 dcuoi) (assoc 11 eget) eget))
)	
   (entmod eget)  
 )
 (command "undo" "end")
 (setvar "osmode" oldos)
 (Princ)
)

Nhờ Bác q288 kết hợp Lisp dưới đây với Lisp trên. Tkx.

(defun c:stext (/ sst lstent egoc pgoc xgoc yht zgoc linespc ee tt)
(if (not tyledong)
(setq tyledong 1.5)
)
(princ "\nSap xep text © CADViet.com")
(setq sst (ssget '((0 . "TEXT")))
lstent (ss2ent sst)
tmp (getreal (strcat "\nVao ty le dong khoang cach dong <"
(rtos tyledong 2 2)
">: "
)
)
tyledong (cond
(tmp tmp)
(t tyledong)
)
lstent (vl-sort lstent
'(lambda (e1 e2)
(> (cadr (cdr (assoc 10 (entget e1))))
(cadr (cdr (assoc 10 (entget e2))))
)
)
)
egoc (car lstent)
lstent (cdr lstent)
pgoc (cdr (assoc 10 (entget egoc)))
xgoc (car pgoc)
yht (cadr pgoc)
zgoc (caddr pgoc)
hgoc (cdr (assoc 40 (entget egoc)))
linespc (* hgoc (+ 1.0 tyledong))

)
(foreach ee lstent
(setq tt (entget ee)
tt (subst (list 10
xgoc
(setq yht (- yht linespc))
zgoc
)
(assoc 10 tt)
tt
)
)
(entmod tt)
(entupd ee)
)
(princ)
)
(defun ss2ent (ss / sodt index lstent)
(setq
sodt (cond
(ss (sslength ss))
(t 0)
)
index 0
)
(repeat sodt
(setq ent (ssname ss index)
index (1+ index)
lstent (cons ent lstent)
)
)
(reverse lstent) 
)
(princ
"\nSTEXT - Sap xep text - free lisp from www.cadviet.com"
)
(vl-load-com)

[q288 166]

Nhờ Bác q288 kết hợp Lisp dưới đây với Lisp trên. Tkx.

 

Kết hợp như dưới đây.

(defun c:st1 ( / oldos lst1 ss ki ki0 ki1 ki2 lst ddau dcuoi eget)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)

 (prompt "Chon Text:")
 (setq ss  (ssget '((0 . "TEXT"))))

 (if (not tyledong)  (setq tyledong 1.5))    
 (setq tyledong1 (getreal (strcat "\nVao ty le dong khoang cach dong <"
			    (rtos tyledong 2 2) ">: ")))     
 (if tyledong1 (setq tyledong tyledong1))

 (setq lst1 '(("L" 0 0)  ("C" 1 0)  ("R" 2 0)  ("M" 4 0)
      ("TL" 0 3)  ("TC" 1 3) ("TR" 2 3)
      ("ML" 0 2)  ("MC" 1 2) ("MR" 2 2)
      ("BL" 0 1)  ("BC" 1 1) ("BR" 2 1)))

 (initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
 (setq ki  (getkword "Enter an option [Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:")
ki1 (cadr (setq ki0 (assoc ki lst1)))
       ki2 (last ki0)	
       lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) 
                                     (caddr (assoc 10 (entget e2))))))										 
vt (cdr (assoc 10 (entget (car lst))))
yht (cadr vt)
linespc (* (cdr (assoc 40 (entget (car lst)))) tyledong)
 )

 (command "undo" "begin")
 (foreach e lst   
(setq eget (entget e)	      
      dtiep (list (car vt) (setq yht (- yht linespc)) 0)
      eget (subst (cons 72 ki1) (assoc 72 eget) eget)
      eget (subst (cons 73 ki2) (assoc 73 eget) eget)
      eget (if (and (zerop ki1) (zerop ki2))
	     (subst (cons 10 dtiep) (assoc 10 eget) eget)
	     (subst (cons 11 dtiep) (assoc 11 eget) eget))
)
   (entmod eget)  
 )
 (command "undo" "end")
 (setvar "osmode" oldos)
 (Princ)
)

[Tue_NV 3.912]

Chào các bác, :lol2:

Mình có 1 vấn đề cần nhờ các bác. Mình có một đường Polyline với nhiều đoạn cong, tại các đoạn cong có các góc đo khác nhau. Nhờ các bác viết cho mình một cái lisp mà khi thực hiện lệnh thì nó sẽ cho ra kết quả là góc tại điểm gấp khúc và khoảng cách từ điểm đó đến điểm đầu của PL. Mình mô tả cụ thể như sau:

 

1/ gõ lệnh và enter

2/ pick chọn đối tượng PL

Sau khi chọn đối tượng PL lisp sẽ thực hiện việc tính toán cho n điểm gấp khúc để cho ra kết quả là: n Góc trong (Góc nhỏ hơn) tại chổ gấp khúc trên PL S=AđộB'C", và cho biết khoảng cách từ điểm đó đến điểm đầu của PL là bao nhiêu đơn vị (L=bao nhiêu hoặc Kn+xyz).

3/ Các giá trị tính toán được tự động chèn vào đúng chổ tại điểm gấp khúc trên PL

4/ Kiểu Text, độ lớn text lấy theo Texstyle hiện hành.

Mong được sự giúp đỡ của các bác. :lol2:

Chào xuantran

Vấn đề tính góc thì có lẽ không có vấn đề gì

Nhưng vấn đề ghi chữ thì bạn đã đặt ra trường hợp tổng quát chưa?

Trong hình vẽ mà bạn upload thì Pline trải dọc theo Ox, chữ viết hình như là theo quy luật // Ox

 

Bạn đã đặt một trường hợp tổng quát là các phân đoạn của Pline nằm nghiêng 1 góc bất kì so với trục Ox chưa?

Như vậy chữ viết sẽ phải viết theo quy luật nào nhỉ?

Bạn đưa ra 1 cái ý thật tổng quát cho bài toán của bạn

Mọi người sẽ giúp bạn

[xuantran15 112]

Chào bác Tue_nv.

Thực ra đây là 1 công đoạn khi tính toán và vẽ sơ họa tuyến, mình nhờ mọi người viết lisp này để tiết kiệm thời gian cho công đoạn này (Vì đối với 1 tuyến Kênh trong TLợi hay thủy điện rất dài và việc làm thủ công khá mất tg). Đây coi như là bước trung gian để lấy số liệu đưa vào sơ họa tuyến, vì thế Bác cứ cho các Text //OX là tốt rồi. Có điều bác cứ cho số đo góc chính xác đến giây nhé, còn việc đo chiều dài từ điểm gấp khúc đến điểm đâu nếu viết theo dạng K?+??? hơi khó thì bác thay băng L=???,?? . Cám ơn bác nhiều :lol2:

[Phiphi- 176]

Kết hợp như dưới đây.

(defun c:st1 ( / oldos lst1 ss ki ki0 ki1 ki2 lst ddau dcuoi eget)
 (setq oldos (getvar "osmode"))
 (setvar "osmode" 0)

 (prompt "Chon Text:")
 (setq ss  (ssget '((0 . "TEXT"))))

 (if (not tyledong)  (setq tyledong 1.5))    
 (setq tyledong1 (getreal (strcat "\nVao ty le dong khoang cach dong <"
			    (rtos tyledong 2 2) ">: ")))     
 (if tyledong1 (setq tyledong tyledong1))

 (setq lst1 '(("L" 0 0)  ("C" 1 0)  ("R" 2 0)  ("M" 4 0)
      ("TL" 0 3)  ("TC" 1 3) ("TR" 2 3)
      ("ML" 0 2)  ("MC" 1 2) ("MR" 2 2)
      ("BL" 0 1)  ("BC" 1 1) ("BR" 2 1)))

 (initget 1 "C L M R TL TC TR ML MC MR BL BC BR")
 (setq ki  (getkword "Enter an option [Center/Left/Middle/Right/TL/TC/TR/ML/MC/MR/BL/BC/BR]:")
ki1 (cadr (setq ki0 (assoc ki lst1)))
       ki2 (last ki0)	
       lst (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
lst (vl-sort lst '(lambda (e1 e2) (> (caddr (assoc 10 (entget e1))) 
                                     (caddr (assoc 10 (entget e2))))))										 
vt (cdr (assoc 10 (entget (car lst))))
yht (cadr vt)
linespc (* (cdr (assoc 40 (entget (car lst)))) tyledong)
 )

 (command "undo" "begin")
 (foreach e lst   
(setq eget (entget e)	      
      dtiep (list (car vt) (setq yht (- yht linespc)) 0)
      eget (subst (cons 72 ki1) (assoc 72 eget) eget)
      eget (subst (cons 73 ki2) (assoc 73 eget) eget)
      eget (if (and (zerop ki1) (zerop ki2))
	     (subst (cons 10 dtiep) (assoc 10 eget) eget)
	     (subst (cons 11 dtiep) (assoc 11 eget) eget))
)
   (entmod eget)  
 )
 (command "undo" "end")
 (setvar "osmode" oldos)
 (Princ)
)

Trên cả mức tuyệt vời.

Cám ơn bác q288 thật nhiều

[Tue_NV 3.912]

Chào bác Tue_nv.

Thực ra đây là 1 công đoạn khi tính toán và vẽ sơ họa tuyến, mình nhờ mọi người viết lisp này để tiết kiệm thời gian cho công đoạn này (Vì đối với 1 tuyến Kênh trong TLợi hay thủy điện rất dài và việc làm thủ công khá mất tg). Đây coi như là bước trung gian để lấy số liệu đưa vào sơ họa tuyến, vì thế Bác cứ cho các Text //OX là tốt rồi. Có điều bác cứ cho số đo góc chính xác đến giây nhé, còn việc đo chiều dài từ điểm gấp khúc đến điểm đâu nếu viết theo dạng K?+??? hơi khó thì bác thay băng L=???,?? . Cám ơn bác nhiều :lol2:

Chào bạn xuantran

việc đo chiều dài từ điểm gấp khúc đến điểm đâu nếu viết theo dạng K?+??? thì cũng không khó, chỉ cần bạn nói ra quy luật của nó.

Ở đây Tue_NV viết L= tính từ điiêrm đầu PLine đến điểm đang xét

Bạn chạy thử nhé :

(defun c:ggoc(/ oldos curve cao ddau ddau1 pre i diem1 diem2 gocA gocB gocC 
do dotinh phut giay diemchen1 diemchen2 diemchen10 chuoido L)
(setvar "cmdecho" 0)
(command "undo" "be")
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq curve (car(entsel "\n Chon Polyline :")))
(setq cao (getdist "\n Nhap chieu cao chu :"))
(setq ddau (vlax-curve-getStartPoint curve) i 1)
(setq ddau1 ddau)
(setq pre (vlax-curve-getEndParam curve))

(while (
(setq diem1 (vlax-curve-getPointAtParam curve i))
(setq diem2 (vlax-curve-getPointAtParam curve (1+ i)))           	 
(setq gocA (/ (* (gg ddau diem1) 180) pi))
(setq gocB (/ (* (gg diem1 diem2) 180) pi))
(setq gocC (- 180 gocA gocB))

(setq do (fix gocC))

(setq dotinh (* (- gocC do) 3600))
(setq phut (fix (/ dotinh 60)))
(setq giay (fix (rem dotinh 60)))

(if (> (cadr diem1) (cadr diem2))
(progn
(setq diemchen1 (list (car diem1) (+ (cadr diem1) (* 3.0 cao)) 0))
(setq diemchen2 (list (car diem1) (+ (cadr diem1) (* 1.5 cao)) 0)) 
)
(progn
(setq diemchen1 (list (car diem1) (- (cadr diem1) (* 1.5 cao)) 0))
(setq diemchen2 (list (car diem1) (- (cadr diem1) (* 3.0 cao)) 0))
)
)
(setq chuoido (strcat (rtos do 2 0) "do" (rtos phut 2 0) "'" (rtos giay 2 0) "''"))
(setq L (vlax-curve-getDistAtPoint curve diem1))

(command "style" "" "" "0" "1" "0" "n" "n")
(command "text" "j" "MC" diemchen1 cao "0" chuoido)
(command "text" "j" "MC" diemchen2 cao "0" (strcat "L = " (rtos L 2 0)))

(setq i (1+ i))
(setq ddau diem1)
)
(setq diemchen10 (list (car ddau1) (- (cadr ddau1) (* 1.5 cao)) 0))
(command "text" "j" "MC" diemchen10 cao "0" (strcat "L = " (rtos (vlax-curve-getDistAtPoint curve ddau1) 2 0)))
(setvar "osmode" oldos)
(command "undo" "end")
(princ)
)
;
;
(defun gg(p1 p2)
(setq ang (angle p1 p2))
(while (> ang (/ pi 2)) 
(setq ang (- ang pi))
)
(abs ang)
)

Đã chỉnh sửa

Chỉnh sửa Tháng 6 19, 2009 theo Tue_NV

[ph168xd 313]

Số lượng câu hỏi cũng như câu trả lời nhiều quá

Nên mình không biết tìm ở đâu

 

Mình đang cần lish

đưa các pline thẳng hàng nhau thành 1 pline

và lish

Nhập tỷ lệ Standard Scale của khung viewport bên layout bằng bàn phím

Thanks mng nhiều

 

Xin hỏi luôn, có cách nào insert 1 hình chữ nhật không phải block vào bản vẽ hay không