Nhờ các anh chị giúp 1 đoạn LISP!

Tháng 7 15, 2014

Nhờ các anh chị có thể viết giúp em một đoạn LISP có chức năng đưa tất cả các chân của dimension có khoảng các bằng 0.

Vì không thể diễn tả được hết ý mong muốn nên phiền các anh chị giúp em thì xem file đính kèm nha!

Cảm ơn!

http://www.cadviet.com/upfiles/3/132006_drawing1.dwg

Tháng 7 19, 2014

Có phải ý bạn là muốn đưa chân dim về đầu line có sẵn không?

Tháng 7 22, 2014

Dạ đúng ah!

Em có viết thử 1 đoạn LISP với sự "tận dụng" lại đoạn LISP cutdim trên diễn đàn nhưng vẫn còn bị lỗi. Mong mọi người xem và chỉnh sửa lại giúp em.

Lỗi như sau:

-Khi đầu line PT10 thu về đầu line thì dim đó sẽ trả về giá trị 0.

;;Keo chan dim ve!
(DEFUN C:DTE (/ CMD SS LTH DEM PT DS KDL N70 GOCX GOCY PT13 PT14 PTI PT13I PT14I
                PT13N PT14N O13 O14 N13 N14 OSM OLDERR PT10 PT11)
	(SETQ CMD (GETVAR "CMDECHO"))
	(SETQ OSM (GETVAR "OSMODE"))
	(SETQ OLDERR *error*
      *error* myerror)
	(PRINC "Please select dimension object!")
	(SETQ SS (SSGET))
	(SETVAR "CMDECHO" 0)
	(SETQ DEM 0)
	(COMMAND "UCS" "W")
	(SETQ LTH (SSLENGTH SS))
	(WHILE (< DEM LTH)
		(PROGN
			(SETQ PT (CDR (ASSOC 10 (ENTGET (SSNAME SS DEM)))))
			(SETQ PT (TRANS PT 1 0))
			(SETQ DS (ENTGET (SSNAME SS DEM)))
			(SETQ KDL (CDR (ASSOC 0 DS)))
			(IF (= "DIMENSION" KDL)
				(PROGN
					(SETQ PT10 (CDR (ASSOC 10 DS)))
					(SETQ PT11 (CDR (ASSOC 11 DS)))
					(SETQ PT13 (CDR (ASSOC 13 DS)))
					(SETQ PT14 (CDR (ASSOC 14 DS)))
					(SETQ N70 (CDR (ASSOC 70 DS)))
					(IF (OR (= N70 0) (= N70 32) (= N70 33) (= N70 160) (= N70 161))
						(PROGN
							(SETQ GOCY (ANGLE PT10 PT14))
							(SETQ GOCX (+ GOCY (/ PI 2)))
						)
					)
					(SETVAR "OSMODE" 0)
					(SETQ PTI (POLAR PT GOCX 2))
					(SETQ PT13I (POLAR PT13 GOCY 2))
					(SETQ PT14I (POLAR PT14 GOCY 2))
					(SETQ PT13N (INTERS PT PTI PT13 PT13I NIL))
					(SETQ PT14N (INTERS PT PTI PT14 PT14I NIL))
					(SETQ O13 (ASSOC 13 DS))
					(SETQ O14 (ASSOC 14 DS))
					(SETQ N13 (CONS 13 PT13N))
					(SETQ N14 (CONS 14 PT14N))
					(SETQ DS (SUBST N13 O13 DS))
					(SETQ DS (SUBST N14 O14 DS))
					(ENTMOD DS)
				)
			)
			(SETQ DEM (+ DEM 1))
		)
	)
	(COMMAND "UCS" "P")
	(SETVAR "CMDECHO" CMD)
	(SETVAR "OSMODE" OSM)
	(setq *error* OLDERR)               ; Restore old *error* handler
	(princ "\nCompleted command!")
	(PRINC)
)

Tháng 7 23, 2014

Bạn dùng thử cái này. Dùng cho dim dli và dal. Chọn dim trước rồi chọn line.

Đối với dim dal thì nếu dim và line không song song thì trị của dim sẽ đổi.

 
(defun c:kn(/ ss a)
  (prompt "\nChon Dim:")
  (setq ss (ssget '((0 . "Dimension") (15 0.0 0.0 0.0)))
  a  (car (entsel "\nChon Line:"))
a1 (vlax-curve-getstartpoint a)
a2 (vlax-curve-getendpoint a))
  (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq  tt13 (cdr (assoc 13 (entget obj)))
  tt10 (cdr (assoc 10 (entget obj)))
  tt14 (cdr (assoc 14 (entget obj)))
  tt50 (+ 1.5708 (cdr (assoc 50 (entget obj))))
  a14 (inters tt14 (polar tt14 tt50 1) a1 a2 nil)
  a13 (inters tt13 (polar tt13 tt50 1) a1 a2 nil))
    (entmod (subst (cons 13 a13) (assoc 13 (entget obj)) (entget obj)))
    (entmod (subst (cons 14 a14) (assoc 14 (entget obj)) (entget obj)))
    (entmod (subst (cons 10 tt10) (assoc 10 (entget obj)) (entget obj)))
  )
)

Tháng 7 23, 2014

Cảm ơn anh Tot77, nhưng có lẽ cái này chưa giúp nhiều cho em.

Yêu cầu công việc của em là phải kéo tất cả các chân dim ấy về đầu line. Nên em cần 1 đoạn LISP chỉ cần chọn tất cả các dim ấy và enter là hoàn thành luôn.

Có thể yêu cầu này không cần với đa số nhưng với em thì lại rất cần, mong mọi người giúp!

Tháng 7 23, 2014

Bạn dùng thử cái này. Dùng cho dim dli và dal. Chọn dim trước rồi chọn line.

Đối với dim dal thì nếu dim và line không song song thì trị của dim sẽ đổi.

 
(defun c:kn(/ ss a)
  (prompt "\nChon Dim:")
  (setq ss (ssget '((0 . "Dimension") (15 0.0 0.0 0.0)))
  a  (car (entsel "\nChon Line:"))
a1 (vlax-curve-getstartpoint a)
a2 (vlax-curve-getendpoint a))
  (foreach obj (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
    (setq  tt13 (cdr (assoc 13 (entget obj)))
  tt10 (cdr (assoc 10 (entget obj)))
  tt14 (cdr (assoc 14 (entget obj)))
  tt50 (+ 1.5708 (cdr (assoc 50 (entget obj))))
  a14 (inters tt14 (polar tt14 tt50 1) a1 a2 nil)
  a13 (inters tt13 (polar tt13 tt50 1) a1 a2 nil))
    (entmod (subst (cons 13 a13) (assoc 13 (entget obj)) (entget obj)))
    (entmod (subst (cons 14 a14) (assoc 14 (entget obj)) (entget obj)))
    (entmod (subst (cons 10 tt10) (assoc 10 (entget obj)) (entget obj)))
  )
)

Bạn Tot77 tuy lập trình nhiều nhưng code rất tùy tiện và ít tiếp thu nhận xét của các thành viên khác.

dxf 15 trong help: Definition point for diameter, radius, and angular dimensions (in WCS) DXF: X value; APP: 3D point

Code trên chọn cả Ordinate Dimension và các dim angular, diameter, radius trong các trường hợp trong bản vẽ sau:

http://www.cadviet.com/upfiles/3/19626_select.dwg

Tôi có viết 1 bài về cách filter dim ở đây:

http://www.cadviet.com/forum/topic/78159-dung-bitwise-trong-selection-set-filter-lists/

Tháng 7 23, 2014

Bạn nói hơi khó hiểu "Khi đầu line PT10 thu về đầu line thì dim đó sẽ trả về giá trị 0."

Bạn đưa file nào mà cái lisp dte chạy lỗi mới biết được. File trên chạy bình thường.

Tháng 7 23, 2014

Bạn Tot77 tuy lập trình nhiều nhưng code rất tùy tiện và ít tiếp thu nhận xét của các thành viên khác.

dxf 15 trong help: Definition point for diameter, radius, and angular dimensions (in WCS) DXF: X value; APP: 3D point

Code trên chọn cả Ordinate Dimension và các dim angular, diameter, radius trong các trường hợp trong bản vẽ sau:

http://www.cadviet.com/upfiles/3/19626_select.dwg

Tôi có viết 1 bài về cách filter dim ở đây:

http://www.cadviet.com/forum/topic/78159-dung-bitwise-trong-selection-set-filter-lists/

Cái này có người gọi là "quick code" đấy bạn à, tuỳ tiện hay không thì miễn sao người dùng sử dụng được là ok rồi. Còn chuyện tiếp thu hay không thì bạn chứng minh xem.

Tháng 7 23, 2014

Bạn Tot77 tuy lập trình nhiều nhưng code rất tùy tiện và ít tiếp thu nhận xét của các thành viên khác.

dxf 15 trong help: Definition point for diameter, radius, and angular dimensions (in WCS) DXF: X value; APP: 3D point

Code trên chọn cả Ordinate Dimension và các dim angular, diameter, radius trong các trường hợp trong bản vẽ sau:

http://www.cadviet.com/upfiles/3/19626_select.dwg

Tôi có viết 1 bài về cách filter dim ở đây:

http://www.cadviet.com/forum/topic/78159-dung-bitwise-trong-selection-set-filter-lists/

chẳng biết tuỳ tiện thế nào nhưng cá nhân mình thấy những lisp Tot77 viết dùm mình rất đúng ý và thuận tiện

Tháng 7 23, 2014

Cho e hỏi code (ssget '((0 . "Dimension") (15 0.0 0.0 0.0))) như vậy thì có nghĩa là sao ạ?

Tháng 7 23, 2014

Mọi người xem file này giúp em!http://www.cadviet.com/upfiles/3/132006_drawing1_1.dwg

Tháng 7 23, 2014

Bạn sai ở cái chỗ (SETQ GOCY (ANGLE PT10 PT14))

2 trường hợp trên thì pt10 và pt14 khác nhau cho nên đúng.

Trường hợp cuối thì 2 điểm đó trùng nhau nên góc = 0, đúng ra phải bằng pi/2.

Bạn sửa lại như sau:

(SETQ GOCX (cdr (assoc 50 ds)))

(SETQ GOCY (+ GOCX (/ PI 2)))

(SETQ GOCX (cdr (assoc 50 ds)))

(SETQ GOCY (+ GOCX (/ PI 2)))

Tháng 7 23, 2014

Cho e hỏi code (ssget '((0 . "Dimension") (15 0.0 0.0 0.0))) như vậy thì có nghĩa là sao ạ? Theo e hiểu là chọn Dimension, còn (15 0.0 0.0 0.0) thì sao ạ?

Bác Tot77 giải thích giùm e được không ạ? :(

Tháng 7 23, 2014

(15 0.0 0.0 0.0) là thông số trong cơ sở dữ liệu của cad, nói nôm na là cad gán cho các dim dli, dal và dim ordinate (cái này ít xài) , chỉ có 3 cái đó là giá trị sau 15 là 0 0 0, còn các dim khác thì /= 0.

Bạn xem thêm cái link của bác ndtnv chỉ ra ở trên để tìm hiểu thêm.

Tháng 7 23, 2014

Sorry anh!

Vẫn còn một trường hợp nữa ah!

http://www.cadviet.com/upfiles/3/132006_132006_drawing1_1.dwg

Tháng 7 24, 2014

Hôm qua vội quá nên quên, phải sửa như vầy mới đúng:

(PROGN

(if (member '(100 . "AcDbRotatedDimension") ds)

(SETQ GOCX (CDR (ASSOC 50 DS))

(SETQ GOCX (ANGLE PT13 PT14)))

(SETQ GOCY (+ GOCX (/ PI 2)))

)

Tháng 7 24, 2014

Nhờ các anh chị có thể viết giúp em một đoạn LISP có chức năng đưa tất cả các chân của dimension có khoảng các bằng 0.

Vì không thể diễn tả được hết ý mong muốn nên phiền các anh chị giúp em thì xem file đính kèm nha!

Cảm ơn!

http://www.cadviet.com/upfiles/3/132006_drawing1.dwg

Bạn dùng thử cái này.

(defun C:gs (/ ss ds pt13 pt10 pt13N rot)
  ;; By : Gia_Bach 2014  
  (command "_.undo" "_begin")
  (princ "\nChon kich thuoc :")
  (if (setq ss (ssget "_:L"'((0 . "DIMENSION")(-4 . "<NOT")(-4 . "&")(70 . 7)(-4 . "NOT>"))) )
    (foreach e (vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
      (setq ds (entget e)
	    pt10 (cdr (assoc 10 ds))
	    pt13 (cdr (assoc 13 ds))
	    ds (subst (cons 14 pt10) (assoc 14 ds) ds)
	    rot (cdr (assoc 50 ds))
	    pt13N (inters pt10 (polar pt10 rot 1) pt13 (polar pt13 (+ rot (/ pi 2)) 1)nil)
	    ds (subst (cons 13 pt13N) (assoc 13 ds) ds) )
      (entmod ds) ) )
  (command "_.undo" "_end")
  (princ)  )

Tháng 7 24, 2014

Thanks Gia_bach!

Nó rất hay!

Cảm ơn mọi người!

Tháng 7 31, 2014

Các anh xem giúp em đoạn Lisp này xíu ah!

(defun C:CTE (/ etname  etlist  ettype  newtext
                 et2 etname2 etlist2 ettype2 oldtext)
  (while 
	(if (setq net (nentsel "\nSelect origin text!"))
		(setq
			etname (car net)
			etlist (entget etname)
			ettype (cdr (assoc 0 etlist))
			newtext (cdr (assoc 1 etlist))
		)
	)
	(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
	(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
	(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
	(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
	(if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
	(if (or (= ettype "TEXT") (= ettype "ATTRIB") (= ettype "MTEXT") (= ettype "DIMENSION"))
		(setq et2 (entsel (strcat "\n" "String <" newtext "> will replace for each text you select!")))
		(setq
			etname2 (car et2)
			etlist2 (entget etname2)
			ettype2 (cdr (assoc 0 etlist2))
			oldtext (assoc 1 etlist2)
		)
		(if (or (= ettype2 "TEXT") (= ettype2 "ATTRIB") (= ettype2 "MTEXT") (= ettype2 "DIMENSION"))
			(progn
				(setq etlist2 (subst (cons 1 newtext) oldtext etlist2))
				(entmod etlist2)
				(entupd etname2)
				(if (setq etname2 (car (cadddr et2)))
				(entupd etname2)
				)
			)
			(prompt (strcat "\n<" ettype2 "> Not a text. Select again!"))
		)
    )
	(Command "ERASE" net)
  )
  (princ)
)

Mong muốn của em:

- Chọn đối tượng 1 (có chứa text)

- Chọn đối tượng 2 (có chứa text)

Đoạn LISP có chức năng copy nội dung đối tượng 1 dán vào đối tượng 2 và xóa đối tượng 1.

Vòng lặp đến khi "space" kết thúc lệnh.

Tháng 7 31, 2014

Sửa nhanh cho bạn

Các anh xem giúp em đoạn Lisp này xíu ah!

Mong muốn của em:

- Chọn đối tượng 1 (có chứa text)

- Chọn đối tượng 2 (có chứa text)

Đoạn LISP có chức năng copy nội dung đối tượng 1 dán vào đối tượng 2 và xóa đối tượng 1.

Vòng lặp đến khi "space" kết thúc lệnh.

(defun C:CTE (/ etname  etlist  ettype  newtext
                 et2 etname2 etlist2 ettype2 oldtext net)
  (while
    (if (setq net (nentsel "\nSelect origin text! :"))
        (setq
            etname (car net)
            etlist (entget etname)
            ettype (cdr (assoc 0 etlist))
            newtext (cdr (assoc 1 etlist))
        )
    )
    (if (= (substr newtext 1 4) "\\A1;")(setq newtext (vl-string-subst "" "\\A1;" newtext)))
    (if (or (= ettype "TEXT") (= ettype "ATTRIB") (= ettype "MTEXT") (= ettype "DIMENSION"))
    (progn
        (setq et2 (entsel (strcat "\n" "String <" newtext "> will replace for each text you select!")))
        (setq
            etname2 (car et2)
            etlist2 (entget etname2)
            ettype2 (cdr (assoc 0 etlist2))
            oldtext (assoc 1 etlist2)
        )
                (setq etlist2 (subst (cons 1 newtext) oldtext etlist2))
                (entmod etlist2)
                (entupd etname2)
                (entdel etname)
    );progn
    )
  )
  (princ)
)

Tháng 7 31, 2014

Cảm ơn anh nguyentuyen6 nhưng điều em mong muốn chưa thực hiện được ah!

- Chọn đối tượng 1 (mục đích cuối cùng là để lấy nội dung text thôi)

- Chọn đối tượng 2 ( dán nội dung text vừa lấy được ở đối tượng 1) và sau đó XOÁ ĐỐI TƯỢNG 1 luôn ah!

Và các thao tác này được lặp lại cho đến khi người dùng muốn kết thúc lệnh thì bấm ESC hoặc Space.

Trong đoạn LISP em gửi lên forum thì có dòng lệnh (Command "ERASE" net), trong đó net là đối tượng 1, song nó lại không xoá được và kết thúc lệnh luôn. Còn anh nguyentuyen6 thì giúp em được cái làm nó chạy liên tục (chọn đối tượng 1[copy text], chọn đối tượng 2[paste text];..) chứ chưa xoá đối tượng 1 trong những vòng lặp đó ah.

Mong mọi người xem và sửa lại giúp em.

Xin cảm ơn!

Tháng 8 1, 2014

Anh nguyentuyen6 có thể giúp em thêm 1 dòng lệnh có chức năng XOÁ ĐỐI TƯỢNG 1 trong vòng lặp trên được không ah.

Em đã thử thêm vào nhưng nó không chạy ah.

Tháng 8 1, 2014

Anh nguyentuyen6 có thể giúp em thêm 1 dòng lệnh có chức năng XOÁ ĐỐI TƯỢNG 1 trong vòng lặp trên được không ah.

Em đã thử thêm vào nhưng nó không chạy ah.

Bạn thử lại down lại lisp của mình nhé, mình xóa đối tượng 1 bằng dòng (entdel etname) rồi mà.

Tháng 8 1, 2014

Đoạn lisp trên chỉ xoá những đối tượng chứa text là Dtext hoặc Mtext, còn lại thì nó không xoá đối tượng 1 được.

Có các nào áp dụng cho cả text chứa trong dimension hoặc atribute không ah!

Tháng 8 3, 2014

Xin lỗi vì chưa tìm thấy...

Em muốn tạo một chủ đề mới nhưng đọc bài này chưa tìm thấy nút "GỬI BÀI MỚI" ở đâu hết. Mong mọi người chỉ giúp.

Và em có đoạn code này muốn tham khảo ý kiến mọi người:

(defun c:ART()
	(setvar "cmdecho" 0)
	(while
  		(vl-load-com)
  		(setq tx (vlax-ename->vla-object (car (entsel "\nSelect text to rotate counterclockwise 90 degrees!"))))
		(setq gbd (vla-get-Rotation tx))
		(if (or (= gbd 0) (= gbd (* 0.5 pi))(= gbd (* 1 pi))(= gbd (* 1.5 pi)))
	  		(vla-put-Rotation tx (+ gbd (* 0.5 pi)))
			(vla-put-Rotation tx 0)
		)
	)
	(setvar "cmdecho" 1)
	(princ "\Completed command!")
  	(princ)
)

Khi em chuyển nó từ .lsp thành .vlx thì nó autocad báo thế này:

; Compilation aborted

; error: compiler found fatal error "3302-ART.lsp"

; Compilation aborted

; error: compiler found fatal error "3302-ART.lsp"

; Compilation aborted

Đăng nhập

Nhờ các anh chị giúp 1 đoạn LISP!

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

mrphuocvie 8

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

Tot77 508

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

mrphuocvie 8

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

Tot77 508

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

mrphuocvie 8

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

ndtnv 481

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

Tot77 508

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

Tot77 508

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

genius111 2

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

phamhuy1 8

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

mrphuocvie 8

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

Tot77 508

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

phamhuy1 8

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

Tot77 508

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

mrphuocvie 8

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

Tot77 508

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

gia_bach 1.549

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

mrphuocvie 8

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

mrphuocvie 8

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

nguyentuyen6 130