Hiệu Chỉnh Đường Dùng Lệnh Le

Tháng 1 30, 2016

Mình sử dụng khá nhiều đường Le để ghỉ chú

Để điều chỉnh các đường Le thẳng hàng song song khoảng cách bàng nhau thì rất mất thời gian

Khi có nhiều đường Le có lệnh nào thực hiện được giống lệnh cát chân dim chẳng hạn

Bạn nào có thể viết giúp mình 1 lisp thực hiện điều đó được không.

Thakshttp://www.cadviet.com/upfiles/5/11317_le.dwg

Tháng 1 31, 2016

Tết rùi hay sao mà không thấy ai giúp mình vậy

Tháng 2 1, 2016

bạn nào rảnh viết giúp mình lisp này đi

Tháng 2 2, 2016

Không giúp thì thôi mà cứ ấn dislike vậy

Mà mấy bạn cần thêm thông tin gì để viết lisp này không mà sao k ai viết hộ vây

Tháng 2 2, 2016

An tiếp đi, anh chiều các chú

Tháng 2 2, 2016

Ít thế tiếp đi chứ

Tháng 2 4, 2016

Ít thế tiếp đi chứ

Không hiểu ý bạn muốn ji ? Cắt Le tại gốc hay đâu ? :)

Tháng 2 4, 2016

Không hiểu ý bạn muốn ji ? Cắt Le tại gốc hay đâu ? :)

bạn xem giúp mình file mình gửi mình có ghi đầy đủ yêu cầu

http://www.mediafire.com/download/84hcefvboj2c8q3/Lisp+Le.dwg

bạn xem làm được thì giúp mình viết 1 cái lisp như thế này nhé

thanks

Tháng 2 5, 2016

bạn xem giúp mình file mình gửi mình có ghi đầy đủ yêu cầu

http://www.mediafire.com/download/84hcefvboj2c8q3/Lisp+Le.dwg

bạn xem làm được thì giúp mình viết 1 cái lisp như thế này nhé

thanks

Dường như các objs Le trong bản vẽ của bạn là copy từ đâu đó chứ không phải tạo ra từ lệnh Le :P

Việc tạo Obi Leader từ Lisp phải có ít nhất 2 points nên yêu cầu 2 3 là mù mờ :)

Có thể đáp ứng nguyện vọng 1 của bạn cũng là không đơn giản :wub: nhưng làm được :D

Tháng 2 5, 2016

Nguyện vọng 1 đây :) :

(defun c:Ele (/ getXdata SaVa dxf2va SetXdata doc ms p1 p2 s l l1 lst p3 p4 
pg lm type pt te pts obj lx)
(defun getXdata (obj / typ val)   
(vla-getxdata obj "" 'typ 'val) (if (and typ val) (apply 'mapcar (cons 'cons (list 
(vlax-safearray->list typ) (mapcar 'vlax-variant-value (vlax-safearray->list val)))))) )
(defun SaVa (mode lst)
(vlax-make-variant (vlax-safearray-fill (vlax-make-safearray mode
(cons 0 (1- (length lst)))) lst)) )
(defun dxf2va (lst *typ *val / d)
(set *typ (SaVa vlax-vbInteger (mapcar 'car lst))) 
(set *val (SaVa vlax-vbVariant (mapcar '(lambda (x) (if (listp (setq d (cdr x))) 
(vlax-3D-point d) (vlax-make-variant d))) lst))) )
(defun SetXdata (obj lst) (dxf2va lst 'typ 'val) (vla-SetXData obj typ val) )
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) ms (vla-get-ModelSpace doc))
(princ "\nChon cac Leaders...") (if (and (ssget '((0 . "LEADER"))) (setq p1 (getpoint 
"\nPick chon diem chuan cho cac diem goc cua Leaders...") p2 (polar p1 (* pi 0.5) 1)) ) 
(progn (vlax-for le (setq s (vla-get-ActiveSelectionSet doc)) (setq l (vlax-get le 'Coordinates) 
l1 (reverse (cdddr (reverse l)))) (repeat (/ (length l) 3) (setq lst (cons (list (car l) (cadr l) 
(caddr l)) lst)) (setq l (cdddr l))) (setq p3 (car lst) p4 (polar p3 pi 1) 
pg (inters p1 p2 p3 p4 nil)) (setq lm (append l1 pg))
(setq type (vla-get-type le) pt (vlax-3d-point pg) te (vla-AddMText ms pt 1 "")
pts (SaVa 5 lm)) (setq obj (vla-AddLeader ms pts te type)) (vla-Erase te) 
(if (setq lx (getXdata le)) (SetXdata obj lx) ) (vla-put-Coordinate obj 2 pt)
(vla-put-StyleName obj (vla-get-StyleName le)) (vla-put-layer obj (vla-get-layer le)) 
(vla-put-arrowheadsize obj (vla-get-arrowheadsize le)) (vla-put-DimensionLineColor obj 
(vla-get-DimensionLineColor le)) (vla-Erase le)) (vla-delete s) )) (princ))

Tháng 2 5, 2016

Nguyện vọng 1 đây :) :

(defun c:Ele (/ getXdata SaVa dxf2va SetXdata doc ms p1 p2 s l l1 lst p3 p4 
pg lm type pt te pts obj lx)
(defun getXdata (obj / typ val)   
(vla-getxdata obj "" 'typ 'val) (if (and typ val) (apply 'mapcar (cons 'cons (list 
(vlax-safearray->list typ) (mapcar 'vlax-variant-value (vlax-safearray->list val)))))) )
(defun SaVa (mode lst)
(vlax-make-variant (vlax-safearray-fill (vlax-make-safearray mode
(cons 0 (1- (length lst)))) lst)) )
(defun dxf2va (lst *typ *val / d)
(set *typ (SaVa vlax-vbInteger (mapcar 'car lst))) 
(set *val (SaVa vlax-vbVariant (mapcar '(lambda (x) (if (listp (setq d (cdr x))) 
(vlax-3D-point d) (vlax-make-variant d))) lst))) )
(defun SetXdata (obj lst) (dxf2va lst 'typ 'val) (vla-SetXData obj typ val) )
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) ms (vla-get-ModelSpace doc))
(princ "\nChon cac Leaders...") (if (and (ssget '((0 . "LEADER"))) (setq p1 (getpoint 
"\nPick chon diem chuan cho cac diem goc cua Leaders...") p2 (polar p1 (* pi 0.5) 1)) ) 
(progn (vlax-for le (setq s (vla-get-ActiveSelectionSet doc)) (setq l (vlax-get le 'Coordinates) 
l1 (reverse (cdddr (reverse l)))) (repeat (/ (length l) 3) (setq lst (cons (list (car l) (cadr l) 
(caddr l)) lst)) (setq l (cdddr l))) (setq p3 (car lst) p4 (polar p3 pi 1) 
pg (inters p1 p2 p3 p4 nil)) (setq lm (append l1 pg))
(setq type (vla-get-type le) pt (vlax-3d-point pg) te (vla-AddMText ms pt 1 "")
pts (SaVa 5 lm)) (setq obj (vla-AddLeader ms pts te type)) (vla-Erase te) 
(if (setq lx (getXdata le)) (SetXdata obj lx) ) (vla-put-Coordinate obj 2 pt)
(vla-put-StyleName obj (vla-get-StyleName le)) (vla-put-layer obj (vla-get-layer le)) 
(vla-put-arrowheadsize obj (vla-get-arrowheadsize le)) (vla-put-DimensionLineColor obj 
(vla-get-DimensionLineColor le)) (vla-Erase le)) (vla-delete s) )) (princ))

Mình thử rùi dùng rất tuyệt, bạn viết giúp mình 2 ý còn lại nhé

Thanks

Tháng 2 20, 2016

Nguyện vọng 1 đây :) :

(defun c:Ele (/ getXdata SaVa dxf2va SetXdata doc ms p1 p2 s l l1 lst p3 p4 
pg lm type pt te pts obj lx)
(defun getXdata (obj / typ val)   
(vla-getxdata obj "" 'typ 'val) (if (and typ val) (apply 'mapcar (cons 'cons (list 
(vlax-safearray->list typ) (mapcar 'vlax-variant-value (vlax-safearray->list val)))))) )
(defun SaVa (mode lst)
(vlax-make-variant (vlax-safearray-fill (vlax-make-safearray mode
(cons 0 (1- (length lst)))) lst)) )
(defun dxf2va (lst *typ *val / d)
(set *typ (SaVa vlax-vbInteger (mapcar 'car lst))) 
(set *val (SaVa vlax-vbVariant (mapcar '(lambda (x) (if (listp (setq d (cdr x))) 
(vlax-3D-point d) (vlax-make-variant d))) lst))) )
(defun SetXdata (obj lst) (dxf2va lst 'typ 'val) (vla-SetXData obj typ val) )
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)) ms (vla-get-ModelSpace doc))
(princ "\nChon cac Leaders...") (if (and (ssget '((0 . "LEADER"))) (setq p1 (getpoint 
"\nPick chon diem chuan cho cac diem goc cua Leaders...") p2 (polar p1 (* pi 0.5) 1)) ) 
(progn (vlax-for le (setq s (vla-get-ActiveSelectionSet doc)) (setq l (vlax-get le 'Coordinates) 
l1 (reverse (cdddr (reverse l)))) (repeat (/ (length l) 3) (setq lst (cons (list (car l) (cadr l) 
(caddr l)) lst)) (setq l (cdddr l))) (setq p3 (car lst) p4 (polar p3 pi 1) 
pg (inters p1 p2 p3 p4 nil)) (setq lm (append l1 pg))
(setq type (vla-get-type le) pt (vlax-3d-point pg) te (vla-AddMText ms pt 1 "")
pts (SaVa 5 lm)) (setq obj (vla-AddLeader ms pts te type)) (vla-Erase te) 
(if (setq lx (getXdata le)) (SetXdata obj lx) ) (vla-put-Coordinate obj 2 pt)
(vla-put-StyleName obj (vla-get-StyleName le)) (vla-put-layer obj (vla-get-layer le)) 
(vla-put-arrowheadsize obj (vla-get-arrowheadsize le)) (vla-put-DimensionLineColor obj 
(vla-get-DimensionLineColor le)) (vla-Erase le)) (vla-delete s) )) (princ))

Lisp nay chỉ theo 1 chiều đuoc thôi, nêu Le theo chiều khác hay các huong khac nhau thì không đươc.Bạn có thể viết cho phuong bất kỳ của Le được không

Tháng 2 21, 2016

Lisp nay chỉ theo 1 chiều đuoc thôi, nêu Le theo chiều khác hay các huong khac nhau thì không đươc.Bạn có thể viết cho phuong bất kỳ của Le được không

Code trên tôi viết tổng quát cho việc tạo và xóa objects Le. Có thể một lúc nào đó bạn tự viết cho mình trường hợp 2 và 3 nếu bạn có danh sách các points :D .

Trường hơp 1 có thể rút gọn lại cho Le theo chiều khác hay các huong khac nhau :) :

(defun c:Ele (/ doc p1 s l l1 lst p3 p4 a p2 pg lm)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ "\nChon cac Leaders...") (if (and (ssget '((0 . "LEADER"))) (setq p1 (getpoint 
"\nPick chon diem chuan cho cac diem goc cua Leaders...")) ) 
(progn (vlax-for le (setq s (vla-get-ActiveSelectionSet doc)) (setq l (vlax-get le 'Coordinates) 
l1 (reverse (cdddr (reverse l)))) (repeat (/ (length l) 3) (setq lst (cons (list (car l) (cadr l) 
(caddr l)) lst)) (setq l (cdddr l))) (setq p3 (car lst) p4 (cadr lst) a (angle p4 p3)
p2 (polar p1 (+ a (* pi 0.5)) 1) pg (inters p1 p2 p3 p4 nil)) (setq lm (append l1 pg))
(vlax-put le 'Coordinates lm) ) (vla-delete s) )) (princ))

Tháng 2 21, 2016

Yêu cầu 2: (Chọn 1 leader nhập khoảng cách offset, số lượng, phía để tạo các leader mới theo kiểu offset)

(defun c:tt  (/ LWPoly ang clr ele ent i lma lpl lsp nle npl obi obj ole dis opl pt1 pt2 sll)
 (defun LWPoly  (lst)
  (entmakex (append (list (cons 0 "LWPOLYLINE")
                          (cons 100 "AcDbEntity")
                          (cons 100 "AcDbPolyline")
                          (cons 90 (length lst))
                          (cons 70 0))
                    (mapcar (function (lambda (p) p)) lst))))
 (princ "\nSelect a Leader...!")
 (if (setq ele (ssget "_+.:E:S" '((0 . "LEADER"))))
  (progn (setq ent (ssname ele 0)
               ole (vlax-ename->vla-object ent)
               clr (vla-get-DimensionLineColor ole)
               lsp (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
               lma (vl-remove-if '(lambda (x) (member (car x) '(-1 5 10))) (entget ent)))
         (setq opl (LWPoly lsp)
               obj (vlax-ename->vla-object opl))
         (vla-put-color obj clr)
         (if (and (setq dis (getdist "\nOffset distance: "))
                  (setq sll (getint "\nNumber of Leader:"))
                  (setq pt1 (getpoint "\nSelect side to offset to: ")))
          (progn (setq pt2 (vlax-curve-getclosestpointto obj pt1 t)
                       ang (angle pt1 pt2))
                 (if (< pi ang (* pi 2))
                  (setq dis (- dis)))
                 (setq i 0)
                 (repeat sll
                  (setq obi (vla-offset obj (* dis (setq i (1+ i))))
                        npl (entlast)
                        lpl (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget npl)))
                  (setq nle (vlax-ename->vla-object (entmakex (append lma lpl))))
                  (vla-put-arrowheadsize nle (vla-get-arrowheadsize ole))
                  (vla-put-DimensionLineColor nle clr)
                  (entdel npl))
                 (vla-erase obj)))))
 (princ))

Tháng 2 21, 2016

Code trên tôi viết tổng quát cho việc tạo và xóa objects Le. Có thể một lúc nào đó bạn tự viết cho mình trường hợp 2 và 3 nếu bạn có danh sách các points :D .

Trường hơp 1 có thể rút gọn lại cho Le theo chiều khác hay các huong khac nhau :) :
(defun c:Ele (/ doc p1 s l l1 lst p3 p4 a p2 pg lm)
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(princ "\nChon cac Leaders...") (if (and (ssget '((0 . "LEADER"))) (setq p1 (getpoint 
"\nPick chon diem chuan cho cac diem goc cua Leaders...")) ) 
(progn (vlax-for le (setq s (vla-get-ActiveSelectionSet doc)) (setq l (vlax-get le 'Coordinates) 
l1 (reverse (cdddr (reverse l)))) (repeat (/ (length l) 3) (setq lst (cons (list (car l) (cadr l) 
(caddr l)) lst)) (setq l (cdddr l))) (setq p3 (car lst) p4 (cadr lst) a (angle p4 p3)
p2 (polar p1 (+ a (* pi 0.5)) 1) pg (inters p1 p2 p3 p4 nil)) (setq lm (append l1 pg))
(vlax-put le 'Coordinates lm) ) (vla-delete s) )) (princ))
Thanks bạn.

Về 2 trường hợp kia, thì bạn xem hộ mình nếu lisp chọn điệm làm mốc ( điểm cho trước ) theo các thứ tụ mình chọn, sau đó chọn góc theo chiều mình quay LE, cuối cùng là chọn khoảng cách giua các chân goc quay được không bạn

Tháng 2 21, 2016

Yêu cầu 2: (Chọn 1 leader nhập khoảng cách offset, số lượng, phía để tạo các leader mới theo kiểu offset)

(defun c:tt  (/ LWPoly ang clr ele ent i lma lpl lsp nle npl obi obj ole dis opl pt1 pt2 sll)
 (defun LWPoly  (lst)
  (entmakex (append (list (cons 0 "LWPOLYLINE")
                          (cons 100 "AcDbEntity")
                          (cons 100 "AcDbPolyline")
                          (cons 90 (length lst))
                          (cons 70 0))
                    (mapcar (function (lambda (p) p)) lst))))
 (princ "\nSelect a Leader...!")
 (if (setq ele (ssget "_+.:E:S" '((0 . "LEADER"))))
  (progn (setq ent (ssname ele 0)
               ole (vlax-ename->vla-object ent)
               clr (vla-get-DimensionLineColor ole)
               lsp (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
               lma (vl-remove-if '(lambda (x) (member (car x) '(-1 5 10))) (entget ent)))
         (setq opl (LWPoly lsp)
               obj (vlax-ename->vla-object opl))
         (vla-put-color obj clr)
         (if (and (setq dis (getdist "\nOffset distance: "))
                  (setq sll (getint "\nNumber of Leader:"))
                  (setq pt1 (getpoint "\nSelect side to offset to: ")))
          (progn (setq pt2 (vlax-curve-getclosestpointto obj pt1 t)
                       ang (angle pt1 pt2))
                 (if (< pi ang (* pi 2))
                  (setq dis (- dis)))
                 (setq i 0)
                 (repeat sll
                  (setq obi (vla-offset obj (* dis (setq i (1+ i))))
                        npl (entlast)
                        lpl (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget npl)))
                  (setq nle (vlax-ename->vla-object (entmakex (append lma lpl))))
                  (vla-put-arrowheadsize nle (vla-get-arrowheadsize ole))
                  (vla-put-DimensionLineColor nle clr)
                  (entdel npl))
                 (vla-erase obj)))))
 (princ))

Bị lỗi bạn ơi load xong nó báo lỗi luôn

Command: AP

APPLOAD Leaner - Offset Le ( CEE ).lsp successfully loaded.

Command: ; error: syntax error

Thanks

Tháng 2 22, 2016

Trước hết bạn để nguyên lsp không thay đổi bất kỳ nội dung gì trong nó.

Nghi ngờ:

1. Là bạn thay đổi tên lệnh mà không đúng cú pháp.

2. Do download của diễn đàn -> Giải quyết copy và paste, không down...

Tháng 2 22, 2016

Yêu cầu 2: (Chọn 1 leader nhập khoảng cách offset, số lượng, phía để tạo các leader mới theo kiểu offset)

(defun c:tt  (/ LWPoly ang clr ele ent i lma lpl lsp nle npl obi obj ole dis opl pt1 pt2 sll)
 (defun LWPoly  (lst)
  (entmakex (append (list (cons 0 "LWPOLYLINE")
                          (cons 100 "AcDbEntity")
                          (cons 100 "AcDbPolyline")
                          (cons 90 (length lst))
                          (cons 70 0))
                    (mapcar (function (lambda (p) p)) lst))))
 (princ "\nSelect a Leader...!")
 (if (setq ele (ssget "_+.:E:S" '((0 . "LEADER"))))
  (progn (setq ent (ssname ele 0)
               ole (vlax-ename->vla-object ent)
               clr (vla-get-DimensionLineColor ole)
               lsp (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
               lma (vl-remove-if '(lambda (x) (member (car x) '(-1 5 10))) (entget ent)))
         (setq opl (LWPoly lsp)
               obj (vlax-ename->vla-object opl))
         (vla-put-color obj clr)
         (if (and (setq dis (getdist "\nOffset distance: "))
                  (setq sll (getint "\nNumber of Leader:"))
                  (setq pt1 (getpoint "\nSelect side to offset to: ")))
          (progn (setq pt2 (vlax-curve-getclosestpointto obj pt1 t)
                       ang (angle pt1 pt2))
                 (if (< pi ang (* pi 2))
                  (setq dis (- dis)))
                 (setq i 0)
                 (repeat sll
                  (setq obi (vla-offset obj (* dis (setq i (1+ i))))
                        npl (entlast)
                        lpl (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget npl)))
                  (setq nle (vlax-ename->vla-object (entmakex (append lma lpl))))
                  (vla-put-arrowheadsize nle (vla-get-arrowheadsize ole))
                  (vla-put-DimensionLineColor nle clr)
                  (entdel npl))
                 (vla-erase obj)))))
 (princ))

Ý tưởng của bạn tuyệt vời :) . Tuy nhiên mình xin góp ý nhỏ :) :

- Đoạn code tạo đối tượng opl nên đặt sau phần nhập getdist, getint và getpoint để tránh nếu lở Enter thì không xuất hiện Pline thừa

- Việc xác dis (if (< pi ang (* pi 2)) (setq dis (- dis))) để chọn hướng offset có vẽ không ổn :D

- Ý tưởng offset tạo ra các Leader song song cách đều theo 2 phương, Trong khi chủ thớt muốn có thê là khoảng // trục X khác trục Y.

Tháng 2 22, 2016

+ Cám ơn góp ý của bác pphung183, xin bác tư vấn thêm ở ý 2!

+ ý 3: Nếu leader line chỉ có 2 Segment thì dễ giải quyết hơn, nếu nhiều thì hơi rắc rối. Nếu chủ thớt chấp nhận kiểu multi copy thì OK.

P/S: ý 2 có lẽ dùng clockwise thì ổn.

Tháng 2 23, 2016

+ Cám ơn góp ý của bác pphung183, xin bác tư vấn thêm ở ý 2!

+ ý 3: Nếu leader line chỉ có 2 Segment thì dễ giải quyết hơn, nếu nhiều thì hơi rắc rối. Nếu chủ thớt chấp nhận kiểu multi copy thì OK.

P/S: ý 2 có lẽ dùng clockwise thì ổn.

Dùng cách củ chuối command tạo offset trong vòng lặp repeat cho đỡ nhức đầu :D (bỏ pt2) :

(command "_offset" (* dis (setq i (1+ i))) opl "non" pt1 "")

Tháng 2 23, 2016

Thank bác! nhưng bí quá em mới dùng command.

+ Lsp ở dưới có lẽ đạt được cả Y/c 2 và 3 (do chưa hiểu lắm về ý đồ của chủ thớt trong Y/c 3).

+ Yêu cầu Leader phải có 2 đoạn gấp khúc trở lên (2 Segment).

+ Có 1 leader mẫu trước và dùng kiểu offset như lsp trước.

+ Các Segment trước (về phía mũi tên) có chung cùng khoảng cách offset, Segment cuối cùng có khoảng cách khác.

(defun c:tt  (/ AT:Offset LWPoly ang1 ang2 clr dis dis2 ele ent epe ept i lma lpl lsp nepe nept nle npl obj ole opl pee pt1 pte sll)
 (defun AT:Offset  (O D P / _pt p1 p2 c D g)
  (setq _pt (lambda (s) (vlax-curve-getPointAtDist O (s (vlax-curve-getDistAtPoint O p1) 0.00001))))
  (if (and (setq p1 (vlax-curve-getclosestpointtoprojection O (trans P 1 0) '(0 0 1)))
           (or (setq p2 (setq c (_pt +))) (setq p2 (_pt -)))
           (if (minusp (- (* (- (car p2) (car p1)) (- (cadr (trans P 1 0)) (cadr p1)))
                          (* (- (cadr p2) (cadr p1)) (- (car (trans P 1 0)) (car p1)))))
            (if (vl-position (vla-get-objectname O) '("AcDbLine" "AcDbXline"))
             (setq D (- (abs D)))
             (setq D (abs D)))
            (if (vl-position (vla-get-objectname O) '("AcDbLine" "AcDbXline"))
             (setq D (abs D))
             (setq D (- (abs D)))))
           (or c (setq D (- D)))
           (not (vl-catch-all-error-p (setq g (vl-catch-all-apply 'vla-offset (list O D))))))
   (car (vlax-safearray->list (vlax-variant-value g)))))
 (defun LWPoly  (lst)
  (entmakex (append (list (cons 0 "LWPOLYLINE")
                          (cons 100 "AcDbEntity")
                          (cons 100 "AcDbPolyline")
                          (cons 90 (length lst))
                          (cons 70 0))
                    (mapcar (function (lambda (p) p)) lst))))
 (princ "\nSelect a Leader...!")
 (if (setq ele (ssget "_+.:E:S" '((0 . "LEADER"))))
  (progn (setq ent (ssname ele 0)
               ole (vlax-ename->vla-object ent)
               clr (vla-get-DimensionLineColor ole)
               lsp (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
               pte (cdr (last lsp))
               lma (vl-remove-if '(lambda (x) (member (car x) '(-1 5 10))) (entget ent)))
         (if (> (length lsp) 2)
          (progn (setq opl (LWPoly lsp)
                       obj (vlax-ename->vla-object opl))
                 (vla-put-color obj clr)
                 (if (and (setq dis (getdist "\nOffset distance: "))
                          (or (setq dis2 (getreal (strcat "\nOffset Distance last Segment <" (rtos (* dis 1.5)) ">: ")))
                              (setq dis2 (* dis 1.5)))
                          (setq sll (getint "\nNumber of Leader:"))
                          (setq pt1 (getpoint "\nSelect side to offset to: ")))
                  (progn (setq i 1)
                         (repeat sll
                          (if (AT:Offset obj (* dis i) pt1)
                           (progn (setq npl  (entlast)
                                        lpl  (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget npl))
                                        epe  (cdr (nth (- (length lsp) 2) lpl))
                                        pee  (cdr (nth (- (length lsp) 3) lpl))
                                        ept  (cdr (last lpl))
                                        ang1 (angle epe ept)
                                        ang2 (angle pte ept))
                                  (and (setq nept (polar pte (angle pte ept) (* dis2 i))
                                             nepe (inters pee epe nept (polar nept ang1 (distance ept epe)) nil))
                                       (setq lpl (append (reverse (cddr (reverse lpl))) (list (cons 10 nepe) (cons 10 nept))))
                                       (setq nle (vlax-ename->vla-object (entmakex (append lma lpl)))))
                                  (if nle
                                   (progn nle
                                          (vla-put-arrowheadsize nle (vla-get-arrowheadsize ole))
                                          (vla-put-DimensionLineColor nle clr)))
                                  (entdel npl)))
                          (setq i (1+ i)))))
                 (vla-erase obj))
          (Acet-ui-message "Lisp chi thuc hien voi Line-Leader co so Segment > 1!" "Thong bao!" (+ 0 16 768)))))
 (princ))

Tháng 2 23, 2016

Thank bác! nhưng bí quá em mới dùng command.

+ Lsp ở dưới có lẽ đạt được cả Y/c 2 và 3 (do chưa hiểu lắm về ý đồ của chủ thớt trong Y/c 3).

+ Yêu cầu Leader phải có 2 đoạn gấp khúc trở lên (2 Segment).

+ Có 1 leader mẫu trước và dùng kiểu offset như lsp trước.

+ Các Segment trước (về phía mũi tên) có chung cùng khoảng cách offset, Segment cuối cùng có khoảng cách khác.

(defun c:tt  (/ AT:Offset LWPoly ang1 ang2 clr dis dis2 ele ent epe ept i lma lpl lsp nepe nept nle npl obj ole opl pee pt1 pte sll)
 (defun AT:Offset  (O D P / _pt p1 p2 c D g)
  (setq _pt (lambda (s) (vlax-curve-getPointAtDist O (s (vlax-curve-getDistAtPoint O p1) 0.00001))))
  (if (and (setq p1 (vlax-curve-getclosestpointtoprojection O (trans P 1 0) '(0 0 1)))
           (or (setq p2 (setq c (_pt +))) (setq p2 (_pt -)))
           (if (minusp (- (* (- (car p2) (car p1)) (- (cadr (trans P 1 0)) (cadr p1)))
                          (* (- (cadr p2) (cadr p1)) (- (car (trans P 1 0)) (car p1)))))
            (if (vl-position (vla-get-objectname O) '("AcDbLine" "AcDbXline"))
             (setq D (- (abs D)))
             (setq D (abs D)))
            (if (vl-position (vla-get-objectname O) '("AcDbLine" "AcDbXline"))
             (setq D (abs D))
             (setq D (- (abs D)))))
           (or c (setq D (- D)))
           (not (vl-catch-all-error-p (setq g (vl-catch-all-apply 'vla-offset (list O D))))))
   (car (vlax-safearray->list (vlax-variant-value g)))))
 (defun LWPoly  (lst)
  (entmakex (append (list (cons 0 "LWPOLYLINE")
                          (cons 100 "AcDbEntity")
                          (cons 100 "AcDbPolyline")
                          (cons 90 (length lst))
                          (cons 70 0))
                    (mapcar (function (lambda (p) p)) lst))))
 (princ "\nSelect a Leader...!")
 (if (setq ele (ssget "_+.:E:S" '((0 . "LEADER"))))
  (progn (setq ent (ssname ele 0)
               ole (vlax-ename->vla-object ent)
               clr (vla-get-DimensionLineColor ole)
               lsp (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget ent))
               pte (cdr (last lsp))
               lma (vl-remove-if '(lambda (x) (member (car x) '(-1 5 10))) (entget ent)))
         (if (> (length lsp) 2)
          (progn (setq opl (LWPoly lsp)
                       obj (vlax-ename->vla-object opl))
                 (vla-put-color obj clr)
                 (if (and (setq dis (getdist "\nOffset distance: "))
                          (or (setq dis2 (getreal (strcat "\nOffset Distance last Segment <" (rtos (* dis 1.5)) ">: ")))
                              (setq dis2 (* dis 1.5)))
                          (setq sll (getint "\nNumber of Leader:"))
                          (setq pt1 (getpoint "\nSelect side to offset to: ")))
                  (progn (setq i 1)
                         (repeat sll
                          (if (AT:Offset obj (* dis i) pt1)
                           (progn (setq npl  (entlast)
                                        lpl  (vl-remove-if-not '(lambda (x) (member (car x) '(10))) (entget npl))
                                        epe  (cdr (nth (- (length lsp) 2) lpl))
                                        pee  (cdr (nth (- (length lsp) 3) lpl))
                                        ept  (cdr (last lpl))
                                        ang1 (angle epe ept)
                                        ang2 (angle pte ept))
                                  (and (setq nept (polar pte (angle pte ept) (* dis2 i))
                                             nepe (inters pee epe nept (polar nept ang1 (distance ept epe)) nil))
                                       (setq lpl (append (reverse (cddr (reverse lpl))) (list (cons 10 nepe) (cons 10 nept))))
                                       (setq nle (vlax-ename->vla-object (entmakex (append lma lpl)))))
                                  (if nle
                                   (progn nle
                                          (vla-put-arrowheadsize nle (vla-get-arrowheadsize ole))
                                          (vla-put-DimensionLineColor nle clr)))
                                  (entdel npl)))
                          (setq i (1+ i)))))
                 (vla-erase obj))
          (Acet-ui-message "Lisp chi thuc hien voi Line-Leader co so Segment > 1!" "Thong bao!" (+ 0 16 768)))))
 (princ))

Cảm ơn bạn, có lisp đáp ứng đúng nhu cầu của mình rui

Thanks bạn nhiều

Đăng nhập

Hiệu Chỉnh Đường Dùng Lệnh Le

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

hung1608 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

hung1608 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

hung1608 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

hung1608 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

hung1608 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

hung1608 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

pphung183 428

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

hung1608 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

pphung183 428

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

pphung183 428

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

hung1608 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

hung1608 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

pphung183 428

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

quocmanh04tt 635

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

hung1608 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

hung1608 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

quocmanh04tt 635

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

pphung183 428

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

quocmanh04tt 635

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

pphung183 428