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

[HELP] Lấy đối tượng đầu tiên trong tập chọn

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

Chào mọi người.

Thứ nhất: Dùng hàm gì để lấy đối tượng đầu tiên trong tập chọn này ạ(đối tượng đầu tiên khi mình chọn)

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

Thứ hai: làm thế nào để loại bỏ các dim cùng hàng với nhau ạ(với tất cả các phương)

Em xin Cảm ơn!

  • Vote giảm 1

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

Phần 1 Mình hay lấy kiểu này hơn

(Setq ss (acet-ss-to-list (ssget '((0 . "DIMENSION")))))

Lấy phần tử đầu tiên

(Setq N0 (nth 0 ss))

Phần 2 : Chịu

 

  • Like 1

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
22 phút trước, alisp đã nói:

Không biết cách của Danh Cong với (ssname ss 0) có ra cùng 1 đối tượng không nhỉ?

Trích xuất thì vẫn ra cùng 1 đối tượng thôi bác ạ. Chỉ khác tập hợp ss  1 cái là list, 1 cái dạng tập chọn selection 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
13 giờ trước, DungNguyen685 đã nói:

Chào mọi người.

Thứ nhất: Dùng hàm gì để lấy đối tượng đầu tiên trong tập chọn này ạ(đối tượng đầu tiên khi mình chọn)

  • cadvietlisp.lsp
    lisp help
  •  

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

Thứ hai: làm thế nào để loại bỏ các dim cùng hàng với nhau ạ(với tất cả các phương)

Em xin Cảm ơn!

Bạn xem cái này được không:

 

(DEFUN c:test7  (/ L1 L2 LS SS)

  (DEFUN LM:ListDifference  (l1 l2)
    (VL-REMOVE-IF '(LAMBDA (x) (MEMBER x l2)) l1)
    )
  (DEFUN dxf_ent  (dxf ent)
    (CDR (ASSOC dxf (ENTGET ent)))
    )
  (DEFUN ss->list  (ss / ls)
    (FOREACH n  (SSNAMEX ss)
      (IF (= 'ename (TYPE (CADR n)))
        (SETQ ls (APPEND ls (LIST (CADR n))))
        )
      )
    ls
    )

  (DEFUN phuongtrinhdt  (ent / p a x y)
    (SETQ p (dxf_ent 10 ent)
          a (dxf_ent 50 ent))
    (SETQ x (CAR p)
          y (CADR p))
    (- y
       (* x
          (/ (SIN a) (COS a))
          )
       )
    )

  (DEFUN trungduongthang  (ent ls / tmp)
    (SETQ tmp nil)
    (FOREACH n  ls
      (IF (= (phuongtrinhdt ent) (phuongtrinhdt n))
        (SETQ tmp T))
      )
    tmp
    )

  (SETQ ss (SSGET '((0 . "*DIMENSION*"))))
  (SETQ ls (ss->list ss))

  (SETQ l1 (LIST))
  (FOREACH n  ls
    (IF (NOT (trungduongthang n (VL-REMOVE n ls)))
      (SETQ l1 (APPEND l1 (LIST n)))
      )
    )
  (SETQ l2 (LM:ListDifference ls l1))

;; l2 là list những dim ngang hàng nhé bạn.


 ;; (FOREACH n l2 (ENTDEL n))

(foreach n l2 (ssdel n ss))

(command "copy" ss "" pause pause "")
  )

  • Like 1

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
13 giờ trước, Danh Cong đã nói:

Phần 1 Mình hay lấy kiểu này hơn

(Setq ss (acet-ss-to-list (ssget '((0 . "DIMENSION")))))

Lấy phần tử đầu tiên

(Setq N0 (nth 0 ss))

Phần 2 : Chịu

 

Lấy đối tượng đầu tiên thì mình làm đc rồi còn ý thứ 2 mình chưa làm được.

(setq ss (ssget '((0 . "DIMENSION"))))
(setq ent (ssname ss 0))
(setq ent1 (ssdel ent ss))

 

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
9 giờ trước, cuongtk2 đã nói:

Bạn xem cái này được không:

 

(DEFUN c:test7  (/ L1 L2 LS SS)

  (DEFUN LM:ListDifference  (l1 l2)
    (VL-REMOVE-IF '(LAMBDA (x) (MEMBER x l2)) l1)
    )
  (DEFUN dxf_ent  (dxf ent)
    (CDR (ASSOC dxf (ENTGET ent)))
    )
  (DEFUN ss->list  (ss / ls)
    (FOREACH n  (SSNAMEX ss)
      (IF (= 'ename (TYPE (CADR n)))
        (SETQ ls (APPEND ls (LIST (CADR n))))
        )
      )
    ls
    )

  (DEFUN phuongtrinhdt  (ent / p a x y)
    (SETQ p (dxf_ent 10 ent)
          a (dxf_ent 50 ent))
    (SETQ x (CAR p)
          y (CADR p))
    (- y
       (* x
          (/ (SIN a) (COS a))
          )
       )
    )

  (DEFUN trungduongthang  (ent ls / tmp)
    (SETQ tmp nil)
    (FOREACH n  ls
      (IF (= (phuongtrinhdt ent) (phuongtrinhdt n))
        (SETQ tmp T))
      )
    tmp
    )

  (SETQ ss (SSGET '((0 . "*DIMENSION*"))))
  (SETQ ls (ss->list ss))

  (SETQ l1 (LIST))
  (FOREACH n  ls
    (IF (NOT (trungduongthang n (VL-REMOVE n ls)))
      (SETQ l1 (APPEND l1 (LIST n)))
      )
    )
  (SETQ l2 (LM:ListDifference ls l1))

;; l2 là list những dim ngang hàng nhé bạn.


 ;; (FOREACH n l2 (ENTDEL n))

(foreach n l2 (ssdel n ss))

(command "copy" ss "" pause pause "")
  )

Không được bạn ơ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
13 giờ trước, Danh Cong đã nói:

Phần 1 Mình hay lấy kiểu này hơn

(Setq ss (acet-ss-to-list (ssget '((0 . "DIMENSION")))))

Lấy phần tử đầu tiên

(Setq N0 (nth 0 ss))

Phần 2 : Chịu

 

Mình muốn dùng để loại bỏ ra các đối tượng cùng phương nhau hay bị dính trong lệnh dimspace đó bạn. Bạn có ý tưởng nào không giúp mình với.

(command "dimspace" A B "" 2000)
A: đối tượng chọn đầu trong tập chọn
B: đối tượng còn lại(tập chọn - đối tượng đầu - các đối tượng cùng nằm trên đường thẳng)

 

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

Hay bị dính của bạn là thế nào ? Cứ đoán bệnh bằng lời biết bao giờ ra bệnh ?

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
13 giờ trước, DungNguyen685 đã nói:

như này bạn!

 

+ Dimspace không có lỗi. Lỗi là bạn chưa biết lệnh DimSpace này dùng cho việc gì và dùng nó như thế nào !

Bạn có thể Google dịch cách dùng nó :

 https://knowledge.autodesk.com/support/autocad-lt/learn-explore/caas/CloudHelp/cloudhelp/2019/ENU/AutoCAD-LT/files/GUID-18DF8B02-3E43-4531-ACE0-75FA7161F209-htm.html

  • Like 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
12 giờ trước, Danh Cong đã nói:

 

+ Dimspace không có lỗi. Lỗi là bạn chưa biết lệnh DimSpace này dùng cho việc gì và dùng nó như thế nào !

Bạn có thể Google dịch cách dùng nó :

 https://knowledge.autodesk.com/support/autocad-lt/learn-explore/caas/CloudHelp/cloudhelp/2019/ENU/AutoCAD-LT/files/GUID-18DF8B02-3E43-4531-ACE0-75FA7161F209-htm.html

ý mình không phải là bị lỗi nhưng mình muốn loại bỏ bỏ trường hợp sau khi chọn đối tượng đầu xong tiếp theo mình cho thể chọn tất cả đối tượng khỏi phải loại trừ đối tượng cừng hàng ấy,

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

Không biết như này phù hợp với bạn chưa?

(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
  (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
    (progn
      (setq ssDim (ssget '((0 . "DIMENSION"))))
      (if ssDim
	(progn
	  (setq LtsDim (acet-ss-to-list ssDim))
	  (if (member Obj1 LtsDim)
	    (vl-remove Obj1 LtsDim)
	  )
	  (if LtsDim
	    (progn
	      (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
	      (setq PntG1 (cdr (assoc 11 (entget Obj1))))
	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")
	      (setq ObjXline (entlast))
	      (setq ssChon (ssadd))
	      (foreach eDim LtsDim
		(setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
		(setq PntG2 (cdr (assoc 11 (entget eDim))))
		(setq Kc (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2)))
		(if (and (equal Kc 0.0 1e-8) (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)))
		  (ssadd eDim ssChon)
		)
	      )
	      (entdel ObjXline)
	    )
	  )
	)
      )
    )
  )
  (if ssChon
    (sssetfirst nil ssChon)
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

 

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
8 giờ trước, thanhduan2407 đã nói:

Không biết như này phù hợp với bạn chưa?


(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
  (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
    (progn
      (setq ssDim (ssget '((0 . "DIMENSION"))))
      (if ssDim
	(progn
	  (setq LtsDim (acet-ss-to-list ssDim))
	  (if (member Obj1 LtsDim)
	    (vl-remove Obj1 LtsDim)
	  )
	  (if LtsDim
	    (progn
	      (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
	      (setq PntG1 (cdr (assoc 11 (entget Obj1))))
	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")
	      (setq ObjXline (entlast))
	      (setq ssChon (ssadd))
	      (foreach eDim LtsDim
		(setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
		(setq PntG2 (cdr (assoc 11 (entget eDim))))
		(setq Kc (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2)))
		(if (and (equal Kc 0.0 1e-8) (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)))
		  (ssadd eDim ssChon)
		)
	      )
	      (entdel ObjXline)
	    )
	  )
	)
      )
    )
  )
  (if ssChon
    (sssetfirst nil ssChon)
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

 

lisp nó đang chọn đối tượng đầu tiên mà bạn nhỉ.

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
8 giờ trước, thanhduan2407 đã nói:

Không biết như này phù hợp với bạn chưa?


(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
  (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
    (progn
      (setq ssDim (ssget '((0 . "DIMENSION"))))
      (if ssDim
	(progn
	  (setq LtsDim (acet-ss-to-list ssDim))
	  (if (member Obj1 LtsDim)
	    (vl-remove Obj1 LtsDim)
	  )
	  (if LtsDim
	    (progn
	      (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
	      (setq PntG1 (cdr (assoc 11 (entget Obj1))))
	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")
	      (setq ObjXline (entlast))
	      (setq ssChon (ssadd))
	      (foreach eDim LtsDim
		(setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
		(setq PntG2 (cdr (assoc 11 (entget eDim))))
		(setq Kc (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2)))
		(if (and (equal Kc 0.0 1e-8) (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)))
		  (ssadd eDim ssChon)
		)
	      )
	      (entdel ObjXline)
	    )
	  )
	)
      )
    )
  )
  (if ssChon
    (sssetfirst nil ssChon)
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

 

tính cả trường hợp các phương còn lại

z2398839698479_46692264aeb98132ab41314c6808d44a.jpg.9caefd9240dd662ab74c129f32727a0e.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
18 phút trước, DungNguyen685 đã nói:

tính cả trường hợp các phương còn lại

z2398839698479_46692264aeb98132ab41314c6808d44a.jpg.9caefd9240dd662ab74c129f32727a0e.jpg

Bạn thử xem!

(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
  (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
    (progn
      (setq ssDim (ssget '((0 . "DIMENSION"))))
      (if ssDim
	(progn
	  (setq LtsDim (acet-ss-to-list ssDim))
	  (if (member Obj1 LtsDim)
	    (vl-remove Obj1 LtsDim)
	  )
	  (if LtsDim
	    (progn
	      (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
	      (setq PntG1 (cdr (assoc 11 (entget Obj1))))
	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")
	      (setq ObjXline (entlast))
	      (setq ssChon (ssadd))
	      (foreach eDim LtsDim
		(setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
		(setq PntG2 (cdr (assoc 11 (entget eDim))))
		(setq Kc (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2)))
		(if (and (not (equal Kc 0.0 1e-8))  (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)))
		  (ssadd eDim ssChon)
		)
	      )
	      (entdel ObjXline)
	    )
	  )
	)
      )
    )
  )
  (if ssChon
    (sssetfirst nil ssChon)
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

 

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
7 phút trước, thanhduan2407 đã nói:

Bạn thử xem!


(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
  (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
    (progn
      (setq ssDim (ssget '((0 . "DIMENSION"))))
      (if ssDim
	(progn
	  (setq LtsDim (acet-ss-to-list ssDim))
	  (if (member Obj1 LtsDim)
	    (vl-remove Obj1 LtsDim)
	  )
	  (if LtsDim
	    (progn
	      (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
	      (setq PntG1 (cdr (assoc 11 (entget Obj1))))
	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")
	      (setq ObjXline (entlast))
	      (setq ssChon (ssadd))
	      (foreach eDim LtsDim
		(setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
		(setq PntG2 (cdr (assoc 11 (entget eDim))))
		(setq Kc (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2)))
		(if (and (not (equal Kc 0.0 1e-8))  (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)))
		  (ssadd eDim ssChon)
		)
	      )
	      (entdel ObjXline)
	    )
	  )
	)
      )
    )
  )
  (if ssChon
    (sssetfirst nil ssChon)
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

 

Cảm ơn bạn! nhưng vẫn không đc bạn ơi. giờ thì nó ko chọn đc đối tượng nào luôn.

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

Bạn thử xem thế nào nhé!

(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
  (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
    (progn
      (setq ssDim (ssget '((0 . "DIMENSION"))))
      (if ssDim
	(progn
	  (setq LtsDim (acet-ss-to-list ssDim))
	  (if (member Obj1 LtsDim)
	    (setq LtsDim (vl-remove Obj1 LtsDim))
	  )
	  (if LtsDim
	    (progn
	      (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
	      (setq PntG1 (cdr (assoc 11 (entget Obj1))))
	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")
	      (setq ObjXline (entlast))
	      (setq ssChon (ssadd))
	      (foreach eDim LtsDim
		(setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
		(setq PntG2 (cdr (assoc 11 (entget eDim))))
		(setq KC (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2 T)))
		(if (and (not (equal KC 0.0 1e-1))
			 (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)(equal G2 (- G1 pi) 1e-8))
		    )
		  (ssadd eDim ssChon)
		)
	      )
	      (entdel ObjXline)
	    )
	  )
	)
      )
    )
  )
  (if (> (sslength ssChon) 0)
    (progn
      (Alert (strcat "C\U+00F3 t\U+1EA5t c\U+1EA3 : " (rtos (sslength ssChon) 2 0) " Dim \U+0111\U+01B0\U+1EE3c ch\U+1ECDn"))
      (Prompt (strcat "\nC\U+00F3 t\U+1EA5t c\U+1EA3 : " (rtos (sslength ssChon) 2 0) " Dim \U+0111\U+01B0\U+1EE3c ch\U+1ECDn\n"))
      (sssetfirst nil ssChon)
    )
    (progn
      (Alert "Kh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn")
      (Prompt "\nKh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn\n")
    )
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

 

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
Vào lúc 27/3/2021 tại 20:45, thanhduan2407 đã nói:

Bạn thử xem thế nào nhé!


(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
  (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
    (progn
      (setq ssDim (ssget '((0 . "DIMENSION"))))
      (if ssDim
	(progn
	  (setq LtsDim (acet-ss-to-list ssDim))
	  (if (member Obj1 LtsDim)
	    (setq LtsDim (vl-remove Obj1 LtsDim))
	  )
	  (if LtsDim
	    (progn
	      (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
	      (setq PntG1 (cdr (assoc 11 (entget Obj1))))
	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")
	      (setq ObjXline (entlast))
	      (setq ssChon (ssadd))
	      (foreach eDim LtsDim
		(setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
		(setq PntG2 (cdr (assoc 11 (entget eDim))))
		(setq KC (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2 T)))
		(if (and (not (equal KC 0.0 1e-1))
			 (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)(equal G2 (- G1 pi) 1e-8))
		    )
		  (ssadd eDim ssChon)
		)
	      )
	      (entdel ObjXline)
	    )
	  )
	)
      )
    )
  )
  (if (> (sslength ssChon) 0)
    (progn
      (Alert (strcat "C\U+00F3 t\U+1EA5t c\U+1EA3 : " (rtos (sslength ssChon) 2 0) " Dim \U+0111\U+01B0\U+1EE3c ch\U+1ECDn"))
      (Prompt (strcat "\nC\U+00F3 t\U+1EA5t c\U+1EA3 : " (rtos (sslength ssChon) 2 0) " Dim \U+0111\U+01B0\U+1EE3c ch\U+1ECDn\n"))
      (sssetfirst nil ssChon)
    )
    (progn
      (Alert "Kh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn")
      (Prompt "\nKh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn\n")
    )
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

 

nó chỉ được trường hợp hàng ngang thôi bạn ơi

bbbbbbbbbbbbbbb.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

Mình Test rất OK trên bản vẽ bạn gửi. Còn bạn thao tác thế nào là do bạn. Mình giúp ko mất phí chỉ đến thế. Gửi phí 2 triệu mình giúp đến cuối. Ko thì Cancel. Ko ai miễn phí đâu. Mình viết bằng tâm. Nhưng vì bạn non quá. Mất tgian thêm thì mất phí. "Mọi sự ngu dốt đều trả giá bằng tiền mặt" như lời thầy giáo mình bảo.

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
7 giờ trước, thanhduan2407 đã nói:

Mình Test rất OK trên bản vẽ bạn gửi. Còn bạn thao tác thế nào là do bạn. Mình giúp ko mất phí chỉ đến thế. Gửi phí 2 triệu mình giúp đến cuối. Ko thì Cancel. Ko ai miễn phí đâu. Mình viết bằng tâm. Nhưng vì bạn non quá. Mất tgian thêm thì mất phí. "Mọi sự ngu dốt đều trả giá bằng tiền mặt" như lời thầy giáo mình bảo.

  Mới sáng sớm đọc cái tít của bác thanhduan thấy hết hồn, nhưng khi đọc kỹ lại thì mới hiểu là ông thầy chỉ nói "Đi học phải đóng học phí" , tại ổng dùng từ hơi bị khủng nên hiểu lầm, hehe!!

  Nhân tiện cũng tâm sự vài điều về cơ chế "xin cho" lisp đê hai bên "xin cho" hiểu nhau hơn, nhất là bên "xin".

  Như với tuổi của bác thanhduan thì ít nhất phải mất 10 năm đèn sách, học hỏi mày mò nghiên cứu lisp mới viết được như ngày hôm nay. Lúc đầu vì công việc của chính bản thân, sau đó vì say mê và muốn hoàn thiện năng lực nên sẵn sàng viết giúp người khác. Code lúc đầu còn ngây ngô khờ dại nên sẵn sàng cho không, nhưng càng ngày tích lũy kinh nghiệm code càng lúc càng "tinh" hơn. Khi đó cho không thì cũng đắn đo vì tiếc công sức 10 năm đèn sách, nếu cho không nhiều khi họ lấy code mình về pha chế rồi đóng dấu bản quyền của họ thì có phải là ngu không?

  Cho không được mà bán cũng không xong. Có người bị hacker tống tiền bằng cách dùng app dịch ngược vlx thành lsp, nếu không đưa tiền là họ tung code lên thì khỏi bán, xem như công cốc.

  Cho nên mới nói nếu có cho lsp thì chỉ là lsp thường thôi, đừng đòi hỏi phải là lsp xịn.

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
8 giờ trước, thanhduan2407 đã nói:

Mình Test rất OK trên bản vẽ bạn gửi. Còn bạn thao tác thế nào là do bạn. Mình giúp ko mất phí chỉ đến thế. Gửi phí 2 triệu mình giúp đến cuối. Ko thì Cancel. Ko ai miễn phí đâu. Mình viết bằng tâm. Nhưng vì bạn non quá. Mất tgian thêm thì mất phí. "Mọi sự ngu dốt đều trả giá bằng tiền mặt" như lời thầy giáo mình bảo.

Mình hơi yếu nên không nhìn ra được. Dù gì cũng cảm ơn bạn nhiều nhé!

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 một bạn trong diễn đàn chỉ ra 2 vấn đề này:

Quote

Góc của dim line trong lisp:

(angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1))))

chỉ đúng khi 2 chân dim = nhau. Trường hợp này xảy ra trong hình dim nằm nghiêng 2 chân dim /= nhau => sai

 

(setq PntG1 (cdr (assoc 11 (entget Obj1))))

lấy dxf 11 làm chuẩn sai khi text không còn vị trí ban đầu hoặc nhiều hàng

nên mình xin phép @thanhduan2407 được sửa lại. Để có ai quan tâm thì tham khảo.

(defun C:00 (/ G1 G2 KC LTSDIM OBJ1 OBJXLINE PNTG1 PNTG2 SSCHON SSDIM)
  (vl-load-com)
  (defun *error* (msg)
    (if	Olmode
      (setvar 'osmode Olmode)
    )
    (if	(not (member msg '("*BREAK,*CANCEL*,*EXIT*")))
      (princ (strcat "\nError: " msg))
    )
    (redraw)
    (princ)
  )
  (command "undo" "begin")
  (setq Olmode (getvar "OSMODE"))
  (setvar "OSMODE" 0)
  (setq Obj1 (Car (entsel "\nChon Dimension dau tien: ")))
  (if (= (cdr (assoc 0 (entget Obj1))) "DIMENSION")
    (progn
      (setq ssDim (ssget '((0 . "DIMENSION"))))
      (if ssDim
	(progn
	  (setq LtsDim (acet-ss-to-list ssDim))
	  (if (member Obj1 LtsDim)
	    (setq LtsDim (vl-remove Obj1 LtsDim))
	  )
	  (if LtsDim
	    (progn
		
		
	(if (= 0 (rem (cdr (assoc 70 (entget Obj1))) 2))
        (setq G1 (cdr (assoc 50 (entget Obj1))))
        (setq G1 (angle (cdr (assoc 13 (entget Obj1))) (cdr (assoc 14 (entget Obj1)))))
	)		
		  
	      (setq PntG1 (cdr (assoc 10 (entget Obj1))))
	      (command "Xline" PntG1 (polar PntG1 G1 1.0) "")	
	      (setq ObjXline (entlast))
	      (setq ssChon (ssadd))
	      (foreach eDim LtsDim

	(if (= 0 (rem (cdr (assoc 70 (entget eDim))) 2))
        (setq G2 (cdr (assoc 50 (entget eDim))))
        (setq G2 (angle (cdr (assoc 13 (entget eDim))) (cdr (assoc 14 (entget eDim)))))
    )		

		(setq PntG2 (cdr (assoc 10 (entget eDim))))
		(setq KC (distance PntG2 (vlax-curve-getClosestPointto ObjXline PntG2 T)))
		(if (and (not (equal KC 0.0 1e-1))
			 (or (equal G2 G1 1e-8) (equal G2 (+ G1 pi) 1e-8)(equal G2 (- G1 pi) 1e-8))
		    )
		  (ssadd eDim ssChon)
		)
	      )
(entdel ObjXline)
	    )
	  )
	)
      )
    )
  )
  (if (> (sslength ssChon) 0)
    (progn
      (Alert (strcat "C\U+00F3 t\U+1EA5t c\U+1EA3 : " (rtos (sslength ssChon) 2 0) " Dim \U+0111\U+01B0\U+1EE3c ch\U+1ECDn"))
      (Prompt (strcat "\nC\U+00F3 t\U+1EA5t c\U+1EA3 : " (rtos (sslength ssChon) 2 0) " Dim \U+0111\U+01B0\U+1EE3c ch\U+1ECDn\n"))
      (sssetfirst nil ssChon)
    )
    (progn
      (Alert "Kh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn")
      (Prompt "\nKh\U+00F4ng c\U+00F3 \U+0111\U+1ED1i t\U+01B0\U+1EE3ng n\U+00E0o \U+0111\U+01B0\U+1EE3c ch\U+1ECDn\n")
    )
  )
  (setvar "OSMODE" Olmode)
  (princ)
)

Cảm ơn mọi người rất nhiều!

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  

×