Chuyển đến nội dung
Diễn đàn CADViet
Đăng nhập để thực hiện theo  
matusalem

Cần giúp đỡ chỉnh sửa lisp chạy tọa độ

Các bài được khuyến nghị

http://www.cadviet.com/upfiles/3/112599_trichtdo_1.lsp

hiện e đang sử dụng lisp chạy tọa độ này, lisp chạy theo thứ tự từ phải qua trái, yêu cầu công việc thì chạy từ trái qua phải!mong a chị giúp đỡ chỉnh sửa lisp chạy ngược lại dùm ah!112599_hoi_cad_1.jpg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Có ai giúp E ko ah!

Chắc có lẽ ai cũng ngại sửa code. Hãy dùng lsp này nếu thấy đc


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

;lay toa do thuan chieu kim dong ho

(defun c:laytd (/ p bound k lstpt lstx lsty newlst i bien t1 p1 diem x y ymax kmax n c new name ltext diemve pt p1

p2 p3 p4 p5 p6 pt1 pt2 pt3 pt4 pt5 pt6 pt7 pt8 pt9 pt10 pt11 pt12 pt13 pt14 pt15 pt16 pt17)

(setq osm (getvar "osmode") lay (getvar "clayer") orth (getvar "orthomode"))

(initget 1)(setq p (getpoint "\nPick point :"))

(setvar "osmode" 0) (setq EL (entlast))

(taolop '("vunglaytd" "diemtd" "texttd"))

(setvar "clayer" "vunglaytd")

(command "style" "APTIMA" "vaptimn.ttf" 0 1 0 "" "" "")

(if (/= p nil) (command "-Boundary" p "" ));end if

(setq bound (entlast))

(if (equal bound EL) (exit))

(setq bound (entget bound))

(setq k (cdr (assoc 90 bound)))

(setq lstpt '() lstx '() lsty '() newlst '())

(setq i 1)

(while (<= i k)

(progn

(setq bien (assoc 10 bound))

(setq t1 (member bien bound))

(setq p1 (car t1))

(setq bound (cdr t1))

(setq diem (cdr p1))

(setq x (car diem) y (cadr diem))

(setq lstx (append lstx (list x)) lsty (append lsty (list y)))

(setq lstpt (append lstpt (list diem)))

(setq i (+ 1 i))));while

(setq ymax (maximum lsty))

(setq kmax (vl-position ymax (reverse lsty)))

(setq lstpt (reverse lstpt))

(setq newlst (member (nth kmax lstpt) lstpt))

(setq n 0)

(repeat kmax (setq newlst (append newlst (list (nth n lstpt)))) (setq n (+ 1 n)))

(setq c 0 new '())

(foreach name newlst (setq new (append new (list (append (list (setq c (1+ c))) name)))))

(setq c 1 new (append new (list (nth 0 new))))

(setq ltext '())

(setq ltext (append ltext (list (nth 0 new))))

(setq newlst (append newlst (list (nth 0 newlst))))

(repeat (- (length new) 1)

(setq ltext (append ltext (list (append (nth c new)

(list (distance (append (nth (- c 1) newlst) '(0.0)) (append (nth c newlst) '(0.0))))))))

(setq c (1+ c)));repeat

(setq n 0)

(setvar "clayer" "diemtd")

(repeat (- (length new) 1)

(ndait_addtext (itoa (car (nth n new))) "texttd" 256 (cdr (nth n new)) 1.0 0.0 "aptima" "BL")

(command "CIRCLE" (cdr (nth n new)) "0.25" "")

(setq n (1+ n)));repeat

(setq diemve (getpoint "\nChon vi tri ve bang toa do : "))

(if (null diemve)

(prompt "\nKhong ve bang ! ")

(progn

(setvar "osmode" 0)

(setvar "orthomode" 0)

(taolop '("Text_Bang" "Line_Bang"))

(setq pt diemve)

(taochu "BAÛNG LIEÄT KEÂ TOÏA ÑOÄ GOÙC RANH" "Text_Bang" 256 (polar (polar pt 0.0 2.5) (* 0.5 Pi) 0.75) 1.0 "Aptima")

(command "layer" "s" "Line_Bang" "")

(setq pt1 pt pt (polar pt (* 1.5 pi) 0.25))

(setq p (polar (polar pt 0.0 0.5) (* 1.5 pi) 2.0))

(setq p1 p

p2 (polar (polar p1 0.0 11.8) (* 0.5 pi) 0.25)

p3 (polar (polar p1 0.0 0.5) (* 1.5 Pi) 2.25)

P4 (polar p3 0.0 7.0)

p5 (polar p4 0.0 9.0)

p6 (polar (polar p5 0.0 7.5) (* 0.5 Pi) 1.5))

(setq pt2 (polar pt1 0.0 5.5)

pt3 (polar pt2 0.0 18.0)

pt4 (polar pt3 0.0 5.5)

pt5 (polar pt2 (* 1.5 Pi) 2.5)

pt6 (polar pt5 0.0 9.0)

pt7 (polar pt6 0.0 9.0)

pt8 (polar pt1 (* 1.5 Pi) 5.0)

pt9 (polar pt8 0.0 5.5)

pt10 (polar pt9 0.0 9.0)

pt11 (polar pt10 0.0 9.0)

pt12 (polar pt11 0.0 5.5))

(taochu "Soá hieäu" "Text_Bang" 256 p1 1.0 "Aptima")

(taochu "Toïa ñoä" "Text_Bang" 256 p2 1.0 "Aptima")

(taochu "ñieåm" "Text_Bang" 256 p3 1.0 "Aptima")

(taochu "X( m )" "Text_Bang" 256 p4 1.0 "aptima")

(taochu "Y( m )" "Text_Bang" 256 p5 1.0 "aptima")

(taochu "Caïnh" "Text_Bang" 256 p6 1.0 "aptima")

(command "layer" "s" "Line_Bang" "")

(command "line" pt1 pt2 pt5 pt6 pt7 pt3 pt4 pt12 pt11 pt10 pt9 pt8 pt1 "")

(command "line" pt2 pt3 "")

(command "line" pt5 pt9 "")

(command "line" pt6 pt10 "")

(command "line" pt7 pt11 "")

(setq pt (polar pt (* 1.5 pi) 6.9))

(setq i 0)

(repeat (length ltext) (ghihang pt (nth i ltext)) (setq i (1+ i)) (setq pt (polar pt (* 1.5 pi) 2.0)))

(setq pt13 (polar pt8 (* 1.5 Pi) (+ (* 2.0 (length ltext)) 0.25)))

(setq pt14 (polar pt13 0.0 5.5)

pt15 (polar pt14 0.0 9.0)

pt16 (polar pt15 0.0 9.0)

pt17 (polar pt16 0.0 5.5))

(command "layer" "s" "Line_Bang" "")

(command "line" pt8 pt13 pt14 pt9 "")

(command "line" pt14 pt15 pt10 "")

(command "line" pt15 pt16 pt11 "")

(command "line" pt16 pt17 pt12 "")

));if

(setvar "osmode" osm) (setvar "clayer" lay) (setvar "orthomode" orth)

(princ))

;;Tao lop theo danh sach di kem

(defun taolop (dslop) (mapcar '(lambda (a) (if (null (tblsearch "layer" a)) (command "layer" "N" a ""))) dslop))

;Tra ve so lon nhat trong danh sach a

(defun maximum (a)

(setq i 0 maxa (max (nth 0 a) (nth 1 a)))

(repeat (length a) (setq maxa (max (nth i a) maxa)) (setq i (1+ i))) maxa)

;Ham tao text

;noi dung va kieu "not nil"

;cac doi so khac co the dung nil

(defun Ndait_addtext (noidung lop mau diem caochu goc kieu canhchu / x y va ha)

(cond

((= canhchu "L") (setq va 0 ha 0));Left

((= canhchu "C") (setq va 0 ha 1));Center

((= canhchu "R") (setq va 0 ha 2));Right

;((= canhchu "A") (setq va 0 ha 3));Aligned

((= canhchu "M") (setq va 0 ha 4));Middle

;((= canhchu "F") (setq va 0 ha 5));Fit

((= canhchu "TL") (setq va 3 ha 0));Top Left

((= canhchu "TC") (setq va 3 ha 1));Top Center

((= canhchu "TR") (setq va 3 ha 2));Top Right

((= canhchu "ML") (setq va 2 ha 0));Middle Left

((= canhchu "MC") (setq va 2 ha 1));Middle Center

((= canhchu "MR") (setq va 2 ha 2));Middle Right

((= canhchu "BL") (setq va 1 ha 0));Bottom Left

((= canhchu "BC") (setq va 1 ha 1));Bottom Center

((= canhchu "BR") (setq va 1 ha 2));Bottom Right

(T (setq va 0 ha 0));canhchu false -> Left

);cond

(if (null (tblsearch "style" kieu)) (setq kieu (getvar "textstyle")))

(if (null goc) (setq goc 0.0))

(if (null caochu) (setq caochu 1.0))

(if (null diem) (progn (initget 1) (setq diem (getpoint "\npick point :"))))

(if (null mau) (setq mau 256))

(if (null lop) (setq lop (getvar "clayer")))

(setq x (car diem) y (cadr diem))

(entmod (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 lop)

(cons 62 mau) (cons 100 "AcDbText") (list 10 x y 0.0)

(cons 40 caochu) (cons 50 goc)(cons 1 noidung) (cons 7 kieu)

(cons 72 ha) (list 11 x y 0.0) (cons 100 "AcDbText") (cons 73 va))))

);defun

;-----

(defun taochu (noidung lop mau diem caochu kieu / x y)

(setq x (car diem) y (cadr diem))

(entmod (entmake (list (cons 0 "TEXT") (cons 100 "AcDbEntity") (cons 8 lop) (cons 62 mau)

(cons 100 "AcDbText") (list 10 x y 0.0) (cons 40 caochu)

(cons 1 noidung) (cons 7 kieu))))) ;defun

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

(defun ghihang (pt hang / p p1 p2 p3 pt pt2 pt3 pt4 pt5 t1 t2 t3 t4)

(setq t1 (rtos (car hang) 2 0) t2 (trtos (cadr hang) 3) t3 (trtos (cadr (cdr hang)) 3))

(if (not (null (nth 3 hang))) (setq t4 (trtos (nth 3 hang) 2)))

(setq p1 (polar (polar pt 0.0 2.0) (/ pi 2.0) 0.25) p2 (polar p1 0.0 12.0)

p3 (polar p2 0.0 8.5) p4 (polar (polar p3 0.0 5.5) (* 0.5 Pi) 1.0))

(Ndait_addtext t1 "Text_Bang" 256 p1 0.9 nil "aptima" "C")

(Ndait_addtext t3 "Text_Bang" 256 p2 0.9 nil "aptima" "R")

(Ndait_addText t2 "Text_Bang" 256 p3 0.9 nil "aptima" "R")

(if (not (null t4)) (Ndait_addText t4 "Text_Bang" 256 p4 0.9 nil "aptima" "R")));end of defun

;;Doi so thuc sang chuoi (giong rtos)

;;VD (trtos 1.05 3) -> "1.050"

(defun trtos (Num dec / HSLT N0 N1 N2 N3 them0 them1 CHU)

(setq HSLT dec N0 (+ Num 0.000000001) N1 (- N0 (fix N0)) N2 (rtos N1 2 HSLT)

N3 (- (strlen N2) 2) them0 "." them1 "")

(if (>= N3 HSLT)

(setq CHU (rtos N0 2 HSLT))

(if (= N3 -1)

(setq CHU (strcat (rtos N0 2 HSLT)(if (= HSLT 0) (setq them0 "") (repeat HSLT (setq them0 (strcat them0 "0"))))))

(setq CHU (strcat (rtos N0 2 HSLT)(repeat (- HSLT N3) (setq them1 (strcat them1 "0"))))))) CHU)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

E cảm ơn A TaiNguyen79 rất nhiều ah!Lisp của a rất có ý nghĩa trong công việc của e!A có thể hoàn thiện hơn chút nữa được không ah!

(hình 1) là lisp của A

từ lisp đó, mình có thể bổ sung thêm khoảng cách cạnh  lên như (hình 2) được không A!

trong trường hợp có nhiều đường line khép kính bên trong, mà mình chỉ cần chạy lấy tọa độ của những đỉnh điểm line bên ngoài thì có cách nào lisp mình hiểu không A (minh họa hình 3)

112599_hoicad2_1.jpg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

E cảm ơn A TaiNguyen79 rất nhiều ah!Lisp của a rất có ý nghĩa trong công việc của e!A có thể hoàn thiện hơn chút nữa được không ah!

(hình 1) là lisp của A

từ lisp đó, mình có thể bổ sung thêm khoảng cách cạnh  lên như (hình 2) được không A!

trong trường hợp có nhiều đường line khép kính bên trong, mà mình chỉ cần chạy lấy tọa độ của những đỉnh điểm line bên ngoài thì có cách nào lisp mình hiểu không A

Để ghi giá trị cạnh bạn thêm đoạn này vào liền trước dòng (setq diemve (getpoint "\nChon vi tri ve bang toa do : ")) nhé :

 

(setq n 0)

(repeat (- (length newlst) 1)

(ndait_addtext (rtos (distance (setq p1 (nth n newlst)) (setq p2 (nth (1+ n) newlst))) 2 2) "texttd" 256

(acet-geom-midpoint p1 p2) 1.0 (angle p1 p2) "aptima" "BC")

(setq n (1+ n)))

 

Còn v/đ bên trong vùng chọn có nhiều đối tượng khác thì lsp chỉ có thể xử lý đc nếu chúng khác layer với vùng bao cần lấy toạ độ. Mà nếu đã khác layer thì bạn chỉ cần tắt nó đi trước khi chạy lsp là đc.(Dùng lệnh layoff của Express rất nhanh thôi)

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

E cảm ơn A TaiNguyen79 nhiều ah!trong quá trình chỉnh lisp theo a hướng dẫn, lisp bị lỗi không hiểu được A. E không biết mình làm đúng như A hướng dẫn ko nữa!

A kiểm tra dùm e xem e chỉnh sửa như thế này có đúng như a hướng dẫn hon nha!

và lisp sau khi sửa chỉ hiện ra số thự tự điểm tại đỉnh thửa đất mà không ra được bảng toạ độ nữa A

 

 

112599_hoicad3_2.jpg

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

E cảm ơn A TaiNguyen79 nhiều ah!trong quá trình chỉnh lisp theo a hướng dẫn, lisp bị lỗi không hiểu được A. E không biết mình làm đúng như A hướng dẫn ko nữa!

A kiểm tra dùm e xem e chỉnh sửa như thế này có đúng như a hướng dẫn hon nha!

và lisp sau khi sửa chỉ hiện ra số thự tự điểm tại đỉnh thửa đất mà không ra được bảng toạ độ nữa A

mình đã test lại với đoạn code trên rồi. vẫn ok mà.

chắc có lẽ bạn chưa cài express cho cad nên không có hàm (acet-geom-midpoint) đó thôi.

Nếu đúng vậy bạn thay câu (acet-geom-midpoint p1 p2) bằng câu (list (/ (+ (nth 0 p1) (nth 0 p2)) 2) (/ (+ (nth 1 p1) (nth 1 p2)) 2) 0.0) thử xem

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Xin nhờ Bạn giúp chỉnh sửa thêm ghi số kích thước cạnh trên hình đa giác

và chỉnh phong chữ về fonts VNI-Helve-Condense.TTF phải chỉnh như thế nào ?

Rất mong được Bạn giúp

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Xin nhờ Bạn giúp chỉnh sửa thêm ghi số kích thước cạnh trên hình đa giác

và chỉnh phong chữ về fonts VNI-Helve-Condense.TTF phải chỉnh như thế nào ?

Rất mong được Bạn giúp

Chỉnh font chữ như sau :

sửa (command "style" "APTIMA" "vaptimn.ttf" 0 1 0 "" "" "") thành (command "style" "Helven" "VHELVCN.ttf" 0 1 0 "" "" "")

Sau đó tìm thay tất cả "aptima" thành "Helven" là đc.

Còn bạn muốn chỉnh sửa thêm ghi số kích thước như thế nào hãy nói rõ thêm một chút.

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

  112599_4455.jpg

 

 TaiNguyen79 hướng dẫn dùm e ah!

e thay đổi chỉnh font như hướng dẫn của a mah sao vẫn bị lỗi font!
với lại những text (khoảng cách cạnh)nằm phía dưới (hướng Nam) đều bị quay ngược chữ, a có thể chỉnh sữa cho mặt chữ quay lên
e cảm ơn A

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Xin các bác giúp e phần lisp trích thửa.

có bản đồ cần thửa đất mà lisp chạy lấy dc cả các đối tượng trong thửa cùng khoảng cách và đỉnh thửa đó. có layers thửa đất riêng, chọn layer thửa đất thì toàn bộ các đối tượng bên trong thửa được coppy theo và sếp thành 1 hàng trên bản vẽ theo điểm mình chon

Chia sẻ bài đăng này


Liên kết tới bài đăng
Chia sẻ trên các trang web khác

Tạo một tài khoản hoặc đăng nhập để nhận xét

Bạn cần phải là một thành viên để lại một bình luận

Tạo tài khoản

Đăng ký một tài khoản mới trong cộng đồng của chúng tôi. Điều đó dễ mà.

Đăng ký tài khoản mới

Đăng nhập

Bạn có sẵn sàng để tạo một tài khoản ? Đăng nhập tại đây.

Đăng nhập ngay

Đăng nhập để thực hiện theo  

×