Đến nội dung


Hình ảnh
- - - - -

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


  • Please log in to reply
21 replies to this topic

#21 quocmanh04tt

quocmanh04tt

    biết lệnh imageclip

  • Members
  • PipPipPipPipPipPipPip
  • 665 Bài viết
Điểm đánh giá: 312 (khá)

Đã gửi 23 February 2016 - 02:24 PM

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

  • 1

#22 hung1608

hung1608

    biết lệnh rotate

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

Đã gửi 24 February 2016 - 12:44 AM

 

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


  • 0