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

Tháng 3 23, 2021

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!

Tháng 3 23, 2021

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

Tháng 3 24, 2021

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ỉ?

Tháng 3 24, 2021

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 :))

Tháng 3 24, 2021

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

[✎]
(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 "")
)

Tháng 3 24, 2021

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))

Tháng 3 24, 2021

12 giờ 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ỉ?

Mình đang làm cách này đó bạn!

Tháng 3 24, 2021

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.

Tháng 3 24, 2021

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)

Tháng 3 24, 2021

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 ?

Tháng 3 25, 2021

12 giờ trước, Danh Cong đã nói:

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 ?

như này bạn!

Tháng 3 26, 2021

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

Tháng 3 26, 2021

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,

Tháng 3 26, 2021

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)
)

Tháng 3 27, 2021

8 giờ trước, thanhduan2407 đã nói:

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

00.lsp
[✎]


(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ỉ.

Tháng 3 27, 2021

8 giờ trước, thanhduan2407 đã nói:

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

00.lsp
[✎]


(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

Tháng 3 27, 2021

18 phút trước, DungNguyen685 đã nói:

tính cả trường hợp các phương còn lạ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)
)

Tháng 3 27, 2021

7 phút trước, thanhduan2407 đã nói:

Bạn thử xem!

00.lsp
[✎]


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

Tháng 3 27, 2021

Bạn gửi bản vẽ qua đây mình xem. Hoặc gửi qua Email: heaven2407@gmail.com

Mình thử của mình OK mà

Tháng 3 27, 2021

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)
)

Tháng 3 29, 2021

Vào lúc 27/3/2021 tại 20:45, thanhduan2407 đã nói:

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

00.lsp
[✎]


(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

Tháng 3 29, 2021

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.

Tháng 3 30, 2021

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 sáng sớm đọc cái tít của bác thanhduan thấy hết hồn, nhưng khi đọc kỹ lại thì mới hiểu là ông thầy chỉ nói "Đi học phải đóng học phí" , tại ổng dùng từ hơi bị khủng nên hiểu lầm, hehe!!

Nhân tiện cũng tâm sự vài điều về cơ chế "xin cho" lisp đê hai bên "xin cho" hiểu nhau hơn, nhất là bên "xin".

Như với tuổi của bác thanhduan thì ít nhất phải mất 10 năm đèn sách, học hỏi mày mò nghiên cứu lisp mới viết được như ngày hôm nay. Lúc đầu vì công việc của chính bản thân, sau đó vì say mê và muốn hoàn thiện năng lực nên sẵn sàng viết giúp người khác. Code lúc đầu còn ngây ngô khờ dại nên sẵn sàng cho không, nhưng càng ngày tích lũy kinh nghiệm code càng lúc càng "tinh" hơn. Khi đó cho không thì cũng đắn đo vì tiếc công sức 10 năm đèn sách, nếu cho không nhiều khi họ lấy code mình về pha chế rồi đóng dấu bản quyền của họ thì có phải là ngu không?

Cho không được mà bán cũng không xong. Có người bị hacker tống tiền bằng cách dùng app dịch ngược vlx thành lsp, nếu không đưa tiền là họ tung code lên thì khỏi bán, xem như công cốc.

Cho nên mới nói nếu có cho lsp thì chỉ là lsp thường thôi, đừng đòi hỏi phải là lsp xịn.

Tháng 3 30, 2021

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é!

Tháng 3 30, 2021

Đượ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!

Đăng nhập

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

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

DungNguyen685 40

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

Danh Cong 422

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

alisp 72

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

Danh Cong 422

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

cuongtk2 342

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

DungNguyen685 40

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

DungNguyen685 40

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

DungNguyen685 40

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

DungNguyen685 40

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

Danh Cong 422

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

DungNguyen685 40

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

Danh Cong 422

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

DungNguyen685 40

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

thanhduan2407 272

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

DungNguyen685 40

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

DungNguyen685 40

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

thanhduan2407 272

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

DungNguyen685 40

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

thanhduan2407 272

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

thanhduan2407 272