Đến nội dung


Hình ảnh
* * * - - 8 Bình chọn

Viết lisp theo yêu cầu [phần 2]


  • Chủ đề bị khóa Chủ đề bị khóa
3783 replies to this topic

#2841 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 07 December 2010 - 04:20 PM

Bác có thể chỉ cho e biết 2 block này khác nhau điểm nào với.Nếu được bác sửa giùm e đoạn lisp cho nó trùng với block có sẵn giùm e.E chân thành cảm ơn trước.
http://www.cadviet.c...drawing1_37.dwg

Bạn sử dụng lệnh bedit -> move đường tròn và chữ từ tâm của nó về 0,0,0 là được
Sau đó dùng lệnh Attsync để đồng bộ Block thuộc tính
Đây cũng chính là sự khác nhau giữa 2 Block này.
Nó khác nhau về cách định nghĩa điểm chèn mà thôi

Nếu bạn làm chưa được-> hãy post lên đây, Tue_NV sẽ giúp bạn.
Chúc thành công :undecided:

Hề hề hề,
Bạn này lại chơi khó nhau đây.....
1/- Bản vẽ bạn gửi chỉ có một block duy nhất là block tt. Nếu không nhầm thì điểm chèn của nó trùng với điểm đặt của cái text thuộc tính trong đó.
2/- Cái block thứ hai ở đâu chả biết nên thua luôn. Có nhẽ điểm đặt của nó ở bên Mỹ chăng. Hề hề hề.

Bản vẽ của bạn ấy có 2 Block : 1Block TT và 1 Block tên là ghithep_t
điểm chèn của Block Ghithep_t nằm ở tâm đường tròn thì sẽ chạy đúng bác ạ. Và nếu điểm chèn của block tt cũng nằm ở tâm đường tròn thì nó cũng sẽ không chạy sai. Đơn giản là vậy bác ạ
  • 2

#2842 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 07 December 2010 - 04:51 PM

Bạn sử dụng lệnh bedit -> move đường tròn và chữ từ tâm của nó về 0,0,0 là được
Sau đó dùng lệnh Attsync để đồng bộ Block thuộc tính
Đây cũng chính là sự khác nhau giữa 2 Block này.
Nó khác nhau về cách định nghĩa điểm chèn mà thôi

Nếu bạn làm chưa được-> hãy post lên đây, Tue_NV sẽ giúp bạn.
Chúc thành công :undecided:
Bản vẽ của bạn ấy có 2 Block : 1Block TT và 1 Block tên là ghithep_t
điểm chèn của Block Ghithep_t nằm ở tâm đường tròn thì sẽ chạy đúng bác ạ. Và nếu điểm chèn của block tt cũng nằm ở tâm đường tròn thì nó cũng sẽ không chạy sai. Đơn giản là vậy bác ạ

Ối bác Tue_NV ơi,
Sao bản vẽ bạn ấy post lên, mình mở ra chỉ có trần sì hai cái bock. Mình dùng (entget (car (entsel))) cả hai thằng đều cho ra cái tên là tt cả. Mình vào insert để hiện ra cái bảng chọn tên block cũng chỉ thấy nhõn cái thằng block tt. Vậy chứ cái thằng block Ghithep_t ấy nó trốn chỗ mô hử bác????
Mình tìm chả thấy mới tưởng là bạn ấy nhầm nên post bài tếu tếu vậy để bạn ấy kiểm tra mừ bác.
Mình cũng đoán là nguyên nhân ở cái điểm chèn, song còn nó lệch ra răng thì phải thấy mới biết mà có biết mới mần tiếp được bác ạ. Thế nên mới phải hỏi lại cho rõ mà bác.
Hề hề hề
@ Bạn 790312: Rất xin lỗi bạn nếu mình nhầm. Hề hề hề...
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2843 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 07 December 2010 - 11:16 PM

Ối bác Tue_NV ơi,
Sao bản vẽ bạn ấy post lên, mình mở ra chỉ có trần sì hai cái bock. Mình dùng (entget (car (entsel))) cả hai thằng đều cho ra cái tên là tt cả. Mình vào insert để hiện ra cái bảng chọn tên block cũng chỉ thấy nhõn cái thằng block tt. Vậy chứ cái thằng block Ghithep_t ấy nó trốn chỗ mô hử bác????
Mình tìm chả thấy mới tưởng là bạn ấy nhầm nên post bài tếu tếu vậy để bạn ấy kiểm tra mừ bác.
Mình cũng đoán là nguyên nhân ở cái điểm chèn, song còn nó lệch ra răng thì phải thấy mới biết mà có biết mới mần tiếp được bác ạ. Thế nên mới phải hỏi lại cho rõ mà bác.
Hề hề hề
@ Bạn 790312: Rất xin lỗi bạn nếu mình nhầm. Hề hề hề...

Hề hề chào Bác Bình!
Mấy hôm nây bận quá nên không tham gia cùng các Bác được. Cái block ấy xuất hiện khi dùng lisp phía trên đó Bác. Khi lisp chạy lần đầu thì nó kiểm tra trên bản vẽ có block ghithep_t chưa nếu chưa có thì tạo block này. lần thứ 2 chạy thì nó lấy luôn cái block cũ ra chèn vào vị trí cần. Em dùng lisp đó không thấy báo lỗi như bạn ấy nói để em kiểm tra lại cái đã.
  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2844 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 07 December 2010 - 11:58 PM

Ở đây, anh đã giúp cho công việc cắt theo đường biên của thửa đó, theo khoảng cách bắt kỳ.
Mình nhờ anh giúp bổ sung cho việc cắt vùng khi chọn vào tâm thửa thì cắt theo phạm vi hình chử nhật với yêu cần nhập dài , rộng vào.
Cám ơn anh

Bạn thử cái này nhé. Vùng cắt là hình chữ nhật khi nhập khoảng cách thì hình chữ nhật sẽ rộng thêm ra còn mạch định là hình chữ nhật bao ngoài thửa đất (khi khoảng cách bằng 0). Làm như vậy để trách trưởng hợp khi bạn nhập kích thước hình chữ nhật nhỏ hơn thửa đất thì lisp chạy bị lỗi.

(defun c:cthua ()
(vl-load-com)
(setq oldos (getvar "osmode"))
(setvar "osmode" 0)
(setq p T)
(while p
(setq p (getpoint "\nPick vao vi tri thua muon trich do: "))
(command "boundary" p "")
(setq el1 (entlast))
(setq of (getreal "\nNhap khoang cach muon lay ra xung quanh: "))
(setq recp (acet-ent-geomextents el1))
(setq rec1 (car recp) rec2 (cadr recp))
(command "rectang" rec1 rec2)
(setq elrec (entlast))
(setq ranp (car (acet-geom-vertex-list elrec)))
(setq pout (polar p (angle p ranp) (+ (distance p ranp) of)))
(command "offset" of elrec pout "")
(setq el2 (entlast))
(command "zoom" "e")
(setq lsp (acet-geom-vertex-list el2))
(setq ss (ssget "cp" lsp '((0 . "LINE,LWPOLYLINE"))))
(setq ss (ssdel el1 ss))
(setq ss (ssdel el2 ss))
(setq ss (ssdel elrec ss))
(command "copy" ss "" p (setq pm (getpoint "\nPick vao vi tri can chen")) "")
(setq sstext (laytext el1 (* of 6) pm))
(command "copy" sstext "" p pm "")
(command "move" el1 el2 elrec "" p pm)
(command "offset" 1 el2 p "")
(setq el3 (entlast))
(setq lsf (acet-geom-vertex-list el3))
(setq i 0)
(repeat 2
(command "trim" el2 "" "f")
(repeat (length lsf)
(command (nth i lsf))
(setq i (1+ i))
)
(command "" "")
)
(entdel el1)
(entdel elrec)
(entdel el2)
(entdel el3)
(command "zoom" "p")
(setq dk (getstring "\nTrich thua da hoan thanh. ban co muon tiep tuc khong: : [Co]: "))
(if (or (= (strcase dk) "C") (= dk "")) (setq p T))
(if (= (strcase dk) "K") (setq p nil))
)
(setvar "osmode" oldos)
)
(defun laytext ( plk kc po / elt lstt)
(command "offset" kc plk po "")
(setq elt (entlast))
(setq lstt (acet-geom-vertex-list elt))
(setq sst (ssget "wp" lstt '((0 . "TEXT"))))
(command "undo" 1)
sst
)

  • 0
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2845 phamngoctukts

phamngoctukts

    biết lệnh adcenter

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 1107 Bài viết
Điểm đánh giá: 696 (tốt)

Đã gửi 08 December 2010 - 09:12 AM

Cám ơn Anh.
Mình cắt một hình vuông nhưng lisp chọn nhiều text xung quanh qua. mình muốn khi cắt theo hình qui định với mục đích tìm các cạnh giới hạn các thửa liều kề và tố thửa của các thửa đó.
Mong được anh xem giúp
http://www.cadviet.c.../biendong_a.dwg

Thuật toán để lọc các text của các thửa xung quanh thửa chính thì mình vẫn chưa nghĩ ra. Bạn chịu khó lọc bỏ text thưa bằng tay cho nó chuẫn.
  • 1
Tất cả vì sự phát triển của diễn đàn ...
Cám ơn đừng nói lời suông mà hãy nhấn Hình đã gửi!

#2846 phamthanhbinh

phamthanhbinh

    biết lệnh adcenter

  • Moderator
  • PipPipPipPipPipPipPip
  • 6009 Bài viết
Điểm đánh giá: 3113 (tuyệt vời)

Đã gửi 08 December 2010 - 11:46 AM

Hề hề chào Bác Bình!
Mấy hôm nây bận quá nên không tham gia cùng các Bác được. Cái block ấy xuất hiện khi dùng lisp phía trên đó Bác. Khi lisp chạy lần đầu thì nó kiểm tra trên bản vẽ có block ghithep_t chưa nếu chưa có thì tạo block này. lần thứ 2 chạy thì nó lấy luôn cái block cũ ra chèn vào vị trí cần. Em dùng lisp đó không thấy báo lỗi như bạn ấy nói để em kiểm tra lại cái đã.

Chu choa,
Vậy là mình không hiểu ý bạn đó rồi. Mình cứ tìm cái block có sẵn, đâu dè phải chạy lisp thì mới có cái block thứ hai để kiểm tra. Cái block trong lisp của bác thì mình cũng phương phưởng thấy cái bóng dáng của nó rồi, nhưng cứ tưởng bạn ấy hỏi block khác nữa mới khổ chứ. Cơ khổ, cái tội không hiểu được ý người khác đây.
Hề hề hề......
Sorry cả nhà hỉ.
  • 0
Chúc các quý Anh trên diễn đàn luôn khỏe, đẻ thêm được nhiều thứ để mót.

#2847 lacvanhoa

lacvanhoa

    biết vẽ line

  • Members
  • PipPip
  • 23 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 08 December 2010 - 11:57 PM

Chào anh phamthanhbinh!
Em định nhờ các anh trên diễn đàn sữa lại cái gì gì.net cho nó chạy đúng ý, theo lời anh nói thì nó đã bị mã hoá rồi thì đành bó tay vậy. Cám ơn anh nhiều nhe!
Chúc anh luôn vui vẽ
  • 0

#2848 bangquang

bangquang

    Chưa sử dụng CAD

  • Members
  • Pip
  • 1 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 11 December 2010 - 10:56 AM

Bạn thử xem:
-Thao tác:
+Nhập lệnh: GCM
+Chọn đối tượng (chọn vô tư lisp tự lọc và nhận các đối tượng text) xong thì enter.
+Lisp hỏi Gach phia: Tren/ text: Bạn nhập T thì gạch trên, D thì gạch dưới (enter sẽ mặc định là gạch dưới).
+Lisp hỏi Khoang cach line voi text bang do lon text chia < 5>: Mặc định khoảng cách line với text là 1/5 độ lớn text muốn thay đổi thì bạn gỏ vào, không thì enter.
*Lisp này chưa tối ưu hóa được nhưng hiện mình đang bận nên không tiếp tục hoàn thiện được bạn dùng tạm vậy.
http://www.cadviet.c.../gachchantd.lsp

Đang cần Lisp này. Link trên không down được bà con giúp với
  • 0

#2849 790312

790312

    biết lệnh fillet

  • Members
  • PipPipPipPip
  • 204 Bài viết
Điểm đánh giá: 4 (bình thường)

Đã gửi 12 December 2010 - 08:59 AM

Bác Tue_nv có viết 1 lisp vẽ thép dưới sàn rất tiện mong các bác thêm giùm e dòng lệnh trước câu " đường kính móc tròn" một lựa chọn: "Có móc hay không móc" nếu Có thì "câu đường kính móc tròn" nếu Không thì hỏi "chiều dài đoạn xéo" khi nhập rồi sẽ vẽ nhưng đoạn đầu không phải móc mà cắt thép gồm 1 đoạn thẳng có chiều dài nhập vào và xéo 1 góc 30độ.Mong các bác sửa giúp.
(DEFUN C:SD (/ OLDERR CMD OSM DK PT1 PT2 PT3 PT4 PT5 PT6 STR PRPT GOCX GOCY
PTD PTC)
(SETQ OLDERR *error*
*error* myerror)
(command "layer" "m" "thep" "c" "6" """")
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)
(SETQ DK (GETVAR "USERR3"))
(IF (= DK 0)
(PROGN
(SETQ STR "1")
(SETVAR "USERR3" 100)
)
(SETQ STR (RTOS DK))
)
(SETQ PRPT (STRCAT "Duong kinh moc tron <" STR ">:"))
(SETQ DK (GETREAL PRPT))
(IF (= DK NIL)
(SETQ DK (GETVAR "USERR3"))
(SETVAR "USERR3" DK)
)
(INITGET 7)
(SETQ PTD (GETPOINT "\nFrom point:"))
(INITGET 7)
(SETQ PTC (GETPOINT PTD "\nTo point:"))
(SETVAR "OSMODE" 0)
(SETQ GOCX (ANGLE PTD PTC))
(SETQ GOCY (+ GOCX (/ PI 2)))
(SETQ PT1 (POLAR PTD GOCX (/ (* 100 DK) 2)))
(SETQ PT2 (POLAR PTC (+ GOCX PI) (/ (* 100 DK) 2)))
(SETQ PT3 (POLAR PT1 GOCY (* 100 DK)))
(SETQ PT4 (POLAR PT2 GOCY (* 100 DK)))
(SETQ PT5 (POLAR PT3 GOCX (* 100 DK)))
(SETQ PT6 (POLAR PT4 (+ GOCX PI) (* 100 DK)))
(COMMAND "PLINE" PT5 PT3 "A" PT1 "L" PT2 "A" PT4 "L" PT6 "")
(SETVAR "OSMODE" OSM)
(SETVAR "CMDECHO" CMD)
(PRINC)
)

  • 0

#2850 Tue_NV

Tue_NV

    KS Võ Quang Tuệ

  • Moderator
  • PipPipPipPipPipPipPip
  • 4296 Bài viết
Điểm đánh giá: 3805 (đỉnh cao)

Đã gửi 14 December 2010 - 03:42 PM

Bác Tue_nv có viết 1 lisp vẽ thép dưới sàn rất tiện mong các bác thêm giùm e dòng lệnh trước câu " đường kính móc tròn" một lựa chọn: "Có móc hay không móc" nếu Có thì "câu đường kính móc tròn" nếu Không thì hỏi "chiều dài đoạn xéo" khi nhập rồi sẽ vẽ nhưng đoạn đầu không phải móc mà cắt thép gồm 1 đoạn thẳng có chiều dài nhập vào và xéo 1 góc 30độ.Mong các bác sửa giúp.

Của bạn đây :

(DEFUN C:SD (/ OLDERR CMD OSM DK PT1 PT2 PT3 PT4 PT5 PT6 STR PRPT GOCX GOCY
                PTD PTC ans)
(SETQ OLDERR *error*
      *error* myerror)
(command "layer" "m" "thep" "c" "6" """")
(SETQ CMD (GETVAR "CMDECHO"))
(SETQ OSM (GETVAR "OSMODE"))
(SETVAR "CMDECHO" 0)
(SETQ DK (GETVAR "USERR3"))
(IF (= DK 0)
    (PROGN
     (SETQ STR "1")
     (SETVAR "USERR3" 100)
    )    
    (SETQ STR (RTOS DK))
)

(SETQ PRPT (STRCAT "Duong kinh moc tron <" STR ">:"))
(SETQ DK (GETREAL PRPT))
(IF (= DK NIL)
    (SETQ DK (GETVAR "USERR3"))
    (SETVAR "USERR3" DK)
)

(INITGET 7)
(SETQ PTD (GETPOINT "\nFrom point:"))
(INITGET 7)
(SETQ PTC (GETPOINT PTD "\nTo point:"))
(SETVAR "OSMODE" 0)
(SETQ GOCX (ANGLE PTD PTC))
(SETQ GOCY (+ GOCX (/ PI 2)))
(initget "C K")
(setq ans (getkword "\n Co moc tron hay khong ?"))
(if (= ans "C") (progn
(SETQ PT1 (POLAR PTD GOCX (/ (* 100 DK) 2)))
(SETQ PT2 (POLAR PTC (+ GOCX PI) (/ (* 100 DK) 2)))
(SETQ PT3 (POLAR PT1 GOCY (* 100 DK)))
(SETQ PT4 (POLAR PT2 GOCY (* 100 DK)))
(SETQ PT5 (POLAR PT3 GOCX (* 100 DK)))
(SETQ PT6 (POLAR PT4 (+ GOCX PI) (* 100 DK)))
(COMMAND "PLINE" PT5 PT3 "A" PT1 "L" PT2 "A" PT4 "L" PT6 "")
);progn1
(progn
(SETQ PT1 (POLAR PTD (+ GOCX (/ pi 6)) (/ (* 100 DK) 2)))
(SETQ PT2 (POLAR PTC (+ GOCY (/ pi 3)) (/ (* 100 DK) 2)))
(COMMAND "PLINE" PT1 PTD PTC PT2 "")
);progn
);if

(SETVAR "OSMODE" OSM)
(SETVAR "CMDECHO" CMD)
(PRINC)
)

  • 1

#2851 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 15 December 2010 - 10:20 AM

Đang cần Lisp này. Link trên không down được bà con giúp với

May quá mình còn lưu đây:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(Defun c:GCM ( )
(command "undo" "be")
(if (null sochia)(setq sochia 5))
(Princ "\nHay chon doi tuong :")
(setq SS (ssget '((0 . "TEXT"))))
(setq i 0)
(setq N (sslength ss))

(initget "Tren Duoi")
(setq kieu (getkword "\nGach phia: Tren/ text: "))

(setq sochiam (dnint "\nKhoang cach line voi text bang do lon text chia "sochia))
(setq sochia sochiam)

(cond
((/= Kieu "Tren")
(gachduoi)
)
((= Kieu "Tren")
(gachtren)
)
)

(command "undo" "end")
(Princ)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun gachduoi ()
(while (< i N)
(setq TEXTENT (ssname SS i))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command "ucs" "object" textent)
(setq tbTB (textbox (list (cons -1 textent)))
ll (car tbTB)
ur (cadr tbTB)
ul (list (car ll) (cadr ur))
lr (list (car ur) (cadr ll))
)
(setq dccc (- (cadr ul) (cadr ll)))
(setq ddccc (/ dccc sochiam))
(command "line" (list (car ll)(- (cadr ll) ddccc)) (list (car ur)(- (cadr ll) ddccc)) "")
(command "ucs" "p")
(setq i (1+ i))
(setvar "osmode" luubatdiem)
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun gachtren ()
(while (< i N)
(setq TEXTENT (ssname SS i))
(setq luubatdiem (getvar "osmode"))
(setvar "osmode" 0)
(command "ucs" "object" textent)
(setq tbTB (textbox (list (cons -1 textent)))
ll (car tbTB)
ur (cadr tbTB)
ul (list (car ll) (cadr ur))
lr (list (car ur) (cadr ll))
)
(setq dccc (- (cadr ul) (cadr ll)))
(setq ddccc (/ dccc sochiam))
(command "line" (list (car ll)(+ (cadr ur) ddccc)) (list (car ur)(+ (cadr ur) ddccc)) "")
(command "ucs" "p")
(setq i (1+ i))
(setvar "osmode" luubatdiem)
)
)
;---------------------------------------
(defun nstr (stri def)
(princ stri)
(princ "<")
(princ " ")
(princ def)
(princ ">")
(princ ":")
(princ " ")
);defun nstr
;--------------------
(defun nstr1 (stri)
(princ stri)
(princ "<")
(princ "Nhap vao")
(princ ">")
(princ ":")
(princ " ")
);defun nstr1
;---------------------
(defun nint (prompt def / temp)
(if def
(setq temp (getint (nstr prompt def)))
(setq def (getint (nstr1 prompt)))
);if def
(if temp
(setq def temp)
def
);if temp
);defun nint
;---------------------
(defun dnint (prompt def / temp)
(if def
(setq temp (getreal (nstr prompt def)))
(setq def (getreal (nstr1 prompt)))
);if def
(if temp
(setq def temp)
def
);if temp
);defun nint
;--------------------
(defun ndist (po prompt def / temp) ;nhan kh/cach va luu gia tri mac dinh
(if def
(setq temp (getdist po (nstr prompt def)))
(setq def (getdist po (nstr1 prompt)))
)if def
(if temp
(setq def temp)
def
);if temp
);defun ndist
;-----------------------------------
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;;;;;;;;;;;;;;;;;

  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#2852 hdt4151

hdt4151

    biết vẽ pline

  • Members
  • PipPip
  • 69 Bài viết
Điểm đánh giá: -1 (bình thường)

Đã gửi 15 December 2010 - 11:02 AM

Các bạn giúp mình viết 1 lisp này nhé, trong file cad có các đường line và polyline, break line va polyline tại giao điểm, xuất ra tọa độ của tất cả các điểm có trong hình (điểm đầu, cuối của các line, polyline sau khi break - xóa các điểm trùng nhau).

Trước đó đã có lisp tdd.lsp (xác định tọa độ các đa giác) cũng gần giống với yêu cầu trên nhưng do trình độ có hạn mình vẫn chưa thể chỉnh sửa lại cho phù hợp với yêu cầu trên ....

;; free lisp from cadviet.com
(defun ndt();Nhom doi tuong
(setq sn 1 list_plmoi nil list_pl nil lss nil)
(while (setq ss (ssget "x" '((0 . "lwpolyline"))))
(command "explode" ss)
)
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa sn)))
(while (setq ss (ssget))
(if ss (setq lss (append lss (list ss))))
(princ (strcat "\n Chon nhom doi tuong thu : " (itoa (setq sn (1+ sn))) " hoac an Enter de ket thuc"))
)
(taobo)
)

(defun taobo ()
(setq k 0)
(while (< k (length lss))
(setq ss (nth k lss))
(setq i 0)
(while (< i (sslength ss))
(setq name (ssname ss i)
ent (entget name)
p1 (cdr (assoc 10 ent))
p2 (cdr (assoc 11 ent))
j 0
)
(while (< j (sslength ss))
(setq name1 (ssname ss j)
ent1 (entget name1)
p3 (cdr (assoc 10 ent1))
p4 (cdr (assoc 11 ent1))
giao (inters p1 p2 p3 p4 T)
)
(if (not (eq name name1))
(progn
(if (and (/= giao nil) (not (equal giao p1 0.01)) (not (equal giao p2 0.01))
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
(if (and (/= giao nil) (or (equal giao p1 0.01) (equal giao p2 0.01))
(not (equal giao p3 0.01)) (not (equal giao p4 0.01)))
(progn
(entmake (subst (cons 11 giao) (assoc 11 ent1) ent1))
(setq lm (entlast) ss (ssadd lm ss) dk1 (sslength ss))
(entmod (subst (cons 10 giao) (assoc 10 ent1) ent1))
)
)
)
)
(setq j (1+ j))
)
(setq i (1+ i))
)
(command "region" ss "")
(setq ss (ssget "x" '((0 . "region"))))
(setq i 0)
(setq list_pl (ssadd))
(while (< i (sslength ss))
(setq reg (ssname ss i))
(command "explode" reg)
(setq plp (ssget "p"))
(command "pedit" "l" "" "j" plp "" "")
(setq boun (entlast))
(setq list_pl (ssadd boun list_pl))
(setq i (1+ i))
)
(locbo)
(setq k (1+ k))
)
)

(defun locbo ()
(setq i 0 list_area nil)
(while (< i (sslength list_pl))
(setq boname (ssname list_pl i))
(command "area" "o" boname)
(setq list_area (append (list (getvar "area")) list_area))
(if (and (eq (apply 'max list_area) (getvar "area")) (> (sslength list_pl) 1))
(setq delname boname))
(setq i (1+ i))
)
(command "erase" delname "")
(setq list_pl (ssdel delname list_pl) list_plmoi (append (list list_pl) list_plmoi))
)


(defun c:tdd ()
(inittdd)
(command "undo" "be")
(ndt)
(setq dlst (list (strcat "X" "\t" "Y" "\n"))
oldos (getvar "osmode")
pg (getvar "ucsorg")
file (strcat (getvar "DWGPREFIX") (substr (getvar "DWGNAME") 1
(- (strlen (getvar "DWGNAME")) 4)) ".txt")
pw (getpoint "\n Chon goc toa do ")
ff 3;(getint "\n Nhap so chu so thap phan ")
k 0 id 1
ptlst nil
dlst1 nil
)
(setvar "osmode" 0)
(if (= pw nil) (setq pW (list 0 0 0)))
(setq h 0)
(while (< h (length list_plmoi))
(setq list_pl (nth h list_plmoi))
(setq p 0)
(while (< p (sslength list_pl))
(setq name (ssname list_pl p)
i 0
ptlst nil
obj (vlax-ename->vla-object name)
dlst1 (append (list (strcat "hinh thu: " (rtos id 2 0))) dlst1))
(while (/= (vlax-curve-getPointAtParam obj (1+ i)) nil)
(setq p1 (vlax-curve-getPointAtParam obj i))
(setq dlst1 (append (list (strcat (rtos (- (car p1) (car pw) (car pg)) 2 ff)
"\t"
(rtos (- (cadr p1) (cadr pw) (cadr pg)) 2 ff)
)
)
dlst1))
(setq ptlst (append (list p1) ptlst))
(setq i (1+ i))
)
(setq p (1+ p))
(setq dlst1 (append (list "\n") dlst1))
(setq dlst (append dlst1 dlst))
(setq dlst1 nil)
(setq id (1+ id))
)
(setq h (1+ h))
)
(setq dlst (reverse dlst))
(setq opw (open file "w"))
(foreach n dlst (write-line n opw))
(close opw)
(setvar "osmode" oldos)
(command "undo" "e")
(command "undo" "")
(alert (strcat "Qua trinh da hoan thanh. Toa do cac manh duoc ghi trong file: " file))
(startapp "C:\\windows\\Notepad.exe" file)
)

(defun inittdd ()
(setq
tdd_old_er *error*
*error* tdderror
)
)

(defun tdderror (errmsg)
(loitdd)
)


(defun loitdd ()
(setq *error* tdd_old_er)
(command "undo" "end")
(command "undo" "")
(princ "xay ra loi trong qua trinh thao tac")
)

  • 0

#2853 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 15 December 2010 - 12:34 PM

Cái này bạn Nhập Bán kính bo có 1 lần rồi sử dụng cho các lần sau mà.
Nếu bạn thích thì đây :

(defun c:fr()
(setvar "FILLETRAD" 50)
(command "fillet" pause)
)

Bác Tue_NV ơi bác sửa lại làm sao khi dùng fr thì bo bán kính 50 nhưng khi dùng fillet thì góc đó mặc định theo cad.Tại vì dùng fr thì bo bán kính 50 nhưng khi dùng fillet thì nó lại bo theo fr.Cảm ơn bác.
  • 0

#2854 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 15 December 2010 - 01:51 PM

Bác Tue_NV ơi bác sửa lại làm sao khi dùng fr thì bo bán kính 50 nhưng khi dùng fillet thì góc đó mặc định theo cad.Tại vì dùng fr thì bo bán kính 50 nhưng khi dùng fillet thì nó lại bo theo fr.Cảm ơn bác.

Mình chỉnh nhé:

(defun c:fr()
(setq bkflcu (getvar "filletrad"))
(setvar "FILLETRAD" 50)
(command "fillet" pause)
(while (< 0 (getvar "CMDACTIVE"))
(command pause)
)
(setvar "FILLETRAD" bkflcu)
)
  • 2

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#2855 Thaistreetz

Thaistreetz

    biết lệnh adcenter

  • Advance Member
  • PipPipPipPipPipPipPip
  • 903 Bài viết
Điểm đánh giá: 505 (tốt)

Đã gửi 15 December 2010 - 08:03 PM

Mình chỉnh nhé:

(defun c:fr()
(setq bkflcu (getvar "filletrad"))
(setvar "FILLETRAD" 50)
(command "fillet" pause)
(while (< 0 (getvar "CMDACTIVE"))
(command pause)
)
(setvar "FILLETRAD" bkflcu)
)

Cái này hay à nha, giờ em mới biết. Đây là một trong những lý do em ghét sử dụng hàm command. Thanks anh :undecided:
  • 0

Hình đã gửi
IN HIM, I TRUST. THE TRUST IN MY GOD


#2856 quan08

quan08

    biết vẽ pline

  • Members
  • PipPip
  • 67 Bài viết
Điểm đánh giá: 0 (bình thường)

Đã gửi 16 December 2010 - 11:33 AM

Thực ra chỉ cần chọn 1 nhóm text là đủ. Với mỗi phần tử trong nhóm Text được chọn đó,Lisp sẽ chọn anh text kế bên và "xử" luôn.

Làm theo cách của bạn Tú thì lâu, cách của bác Bình thì khá hơn vì mỗi một text phải duyệt qua toàn bộ text kế bên
và cách của Tue_NV là tốc độ nhanh nhất. :undecided:

Nhưng không thấy lisp nối text của bác TUE_NV đâu cả.Thanks
  • 0

#2857 NguyenNdait

NguyenNdait

    biết vẽ line

  • Members
  • PipPip
  • 28 Bài viết
Điểm đánh giá: 5 (bình thường)

Đã gửi 16 December 2010 - 12:48 PM

Mình đang phải làm công việc sau khi có file đo hiện trạng, nhưng đơn vi đo đạc chỉ giao file hiện trạng mà ác lại đưa về cùng một lớp. Tách lọc các số cao độ từng số thì qua lâu.
Nay mình nhờ các anh giúp LISP : làm thế nào mà lọc các text có cao độ sang 1 lớp khác có tên là Caodo
CÁM ƠN
http://www.cadviet.c...ientrang_01.rar

Cái file bạn gởi không có cái text nào cả mà.
Nhưng thử dùng cái này xem sao nhé :
 
;;tach chu va so ra cac lop rieng biet
(defun c:chu_so (/ SS1 LopT LopN Count En Eg)
(luuBHT);luu bien he thong
(setvar "cmdecho" 0) (setvar "osmode" 0) (setvar "blipmode" 0) (setvar "orthomode" 0)
(princ "\nChon cac chu ")
(while (null (setq SS1 (ssget (list (cons 0 "Text"))))) (princ "\nChua chon duoc chu "))
(if (= (setq LopT (getstring "\nNhap ten lop se chua cac chu ")) "") (setq LopT "Tamchu"))
(if (= (setq LopN (getstring "\nNhap ten lop se chua cac so ")) "") (setq LopN "Tamso"))
(setq Count 0)
(repeat (sslength SS1)
(setq En (ssname SS1 Count) Eg (entget En))
(if (numberp (distof (cdr (assoc 1 eg))))
(setq Eg (subst (cons 8 lopN) (assoc 8 Eg) Eg))
(setq Eg (subst (cons 8 LopT) (assoc 8 Eg) Eg)));if
(setq Count (1+ Count))
(entmod Eg));repeat
(traBHT);tra bien he thong
(princ))

  • 0

Mầm non phường ba - Đây ta mầm cụ
Lãnh tụ non sông - Ngộ không.


#2858 duy782006

duy782006

    PHẠM QUỐC DUY

  • CADViet Team
  • PipPipPipPipPipPipPip
  • 2155 Bài viết
Điểm đánh giá: 1359 (rất tốt)

Đã gửi 16 December 2010 - 02:13 PM

Cái này hay à nha, giờ em mới biết. Đây là một trong những lý do em ghét sử dụng hàm command. Thanks anh :undecided:

Cái này mình cũng lượm trên cadviet lúc trước cũng vướng cái chổ thực trả lệnh về cho cad làm việc xong lấy lại cho lisp làm việc tiếp ghê lắm từ ngày có anh này cải tạo được mấy cái lisp củ chuối khi xưa.
  • 0

Cứ ngỡ trần gian là cõi thật.Cho nên tất bật đến bây giờ.
Tạo hộp thoại bằng lisp My blog QUY ĐỊNH ĐẶT TÊN TOPIC TRONG CHUYÊN MỤC LISPD http://ktsduy.wordpress.com/
Để cám ơn chỉ cần nhấn rep_up.png
(Là nhấn vào nút đó phía bài viết của người ta í chứ đừng có nhè cái hình này mà nhấn miết đi nha :-D


#2859 NguyenNdait

NguyenNdait

    biết vẽ line

  • Members
  • PipPip
  • 28 Bài viết
Điểm đánh giá: 5 (bình thường)

Đã gửi 16 December 2010 - 03:06 PM

Mình không chạy được, hay do mình sử dụng Cad2004.
Bạn viết để chạy trên cad nào ? mong đựơc chỉ giúp

Bạn bỏ 2 câu luuBHT và traBHT đi là đc. Vì 2 câu này chỉ để bảo toàn biến hệ thống mà thôi.
  • 1

Mầm non phường ba - Đây ta mầm cụ
Lãnh tụ non sông - Ngộ không.


#2860 NguyenNdait

NguyenNdait

    biết vẽ line

  • Members
  • PipPip
  • 28 Bài viết
Điểm đánh giá: 5 (bình thường)

Đã gửi 16 December 2010 - 04:49 PM

Mình xin nhờ anh giúp cho việc trích thửa ra và in theo tỉ lệ.
Trong màn hình thì setup nó là 1:1 , nếu cần in thì ta chọn theo tỉ lệ in nhu 1:500 thì chọn 1 : 0.5 , v,v...
Nhưng vẩn để tỉ lệ là 1:1 mà khi trích thửa như trên, chọn vùng để ghi và lisp yêu vầu tỉ lệ in là bao nhiêu ?
Khi đó thửa được trích ra sẻ thu hay phóng theo tỉ lệ mà ta chọn.
Như vậy ta có mẫu khung chuẩn 1:1 và thủa sẻ tăng giảm theo tỉ lệ và để phù họp theo khung.
Rất mong được anh giúp. Cám ơn
http://www.cadviet.c..._theo_ti_le.rar

Hy vọng đây là cái bạn cần :
http://www.cadviet.c...lvtcu_ndait.lsphttp://www.cadviet.c...dait_extrim.lsp
Tắt bớt các lớp không cần thiết trước sau đó
Bạn chọn vùng cần đặt thửa sau khi trích
Rồi chọn vùng trên BĐGT (Dùng kèm chuột giữa sẽ rất linh động)
Đối với những thửa lân cận mà số thửa của nó nằm ngoài vùng chọn thì thêm vao lúc ctrình yêu cầu bổ sung.
Rồi chọn 1 điểm tại 1 vùng đủ trống để ctrình có chỗ thao tác
TB: Nhớ load file ndait_extrim trước nhé.
  • 0

Mầm non phường ba - Đây ta mầm cụ
Lãnh tụ non sông - Ngộ không.