[编程交流] 预定尺寸DIMLINEAR

(defun c:Test (/ a b c d x 1p 2p 3p 4p bk)
 ;;        Tharwat 09.Dec.2014        ;;
 (if
   (and
     (setq a (getpoint "\n Specify point A :"))
     (setq b (getpoint "\n Specify point B on the right side :" a))
     (if (and (> (car b) (car a))
              (equal (cadr a) (cadr b) 1e-4)
         )
       t
       (progn
         (alert "Point B must be on the right side of point A and on the same line ")
         nil
       )
     )
     (setq c (getpoint "\n Specify point CG below the mid-point of A and B :"))
     (setq d (distance a b))
   )
    (cond
      ((and (< (cadr c) (cadr a))
            (< (car c) (car b))
            (> (car c) (car a))
            (< 0
               (- (distance a (setq x (list (car c) (cadr a))))
                  (+ (* d 0.292) (/ (* d 0.208) 2.))
               )
            )
       )
       (setq 1p (polar x pi (+ (* d 0.292) (/ (* d 0.208) 2.)))
             2p (polar 1p 0. (* d 0.292))
             3p (polar x 0. (/ (* d 0.208) 2.))
             4p (polar 3p 0. (* d 0.292))
             bk (vlax-get (vla-get-activelayout
                            (vla-get-activedocument (vlax-get-acad-object))
                          )
                          'Block
                )
       )
       (mapcar
         '(lambda (q p)
            (vla-AddDimAligned
              bk
              (vlax-3D-point q)
              (vlax-3D-point p)
              (vlax-3D-point (polar q (* pi 0.5) (/ (* d 0.208) 2.)))
            )
          )
         (list a 1p 2p 3p 4p)
         (list 1p 2p 3p 4p b)
       )
       (vla-AddDimAligned
         bk
         (vlax-3D-point a)
         (vlax-3D-point b)
         (vlax-3D-point (polar a (* pi 0.5) (* d 0.208)))
       )
      )
      (t (princ "\n ** Invalid inputs !! **"))
    )
 )
 (princ)
)(vl-load-com)

(defun c:dimft (/ *error* u ss) 
 (if (setq ss (ssget ":L" '((0 . "DIMENSION"))))
   (foreach obj (acet-ss-to-list ss)
     (mapcar ''((a b) (vlax-put  (vlax-ename->vla-object obj) a b))
      '("UnitsFormat" "PrimaryUnitsPrecision") '(4 [color="red"]0[/color])) ;_ end of mapcar
     )
   ) ;_ end of if
 (princ)
 ) ;_ end of defun

 
(defun c:Test (/ a b c d x 1p 2p 3p 4p bk [color="red"]m-ft[/color])
;;        Tharwat 09.Dec.2014        ;;
[color="red"](defun m-ft nil
(mapcar ''((a b) (vlax-put  (vlax-ename->vla-object (entlast)) a b))
      '("UnitsFormat" "PrimaryUnitsPrecision") '(4 0)) ;_ end of mapcar
 )[/color]
...
...
...
...
...
[color="#696969"] (mapcar
         '(lambda (q p)
            (vla-AddDimAligned
              bk
              (vlax-3D-point q)
              (vlax-3D-point p)
              (vlax-3D-point (polar q (* pi 0.5) (/ (* d 0.208) 2.)))
            )
     
[color="red"](m-ft)[/color]
     
          )
         (list a 1p 2p 3p 4p)
         (list 1p 2p 3p 4p b)
       )
       (vla-AddDimAligned
         bk
         (vlax-3D-point a)
         (vlax-3D-point b)
         (vlax-3D-point (polar a (* pi 0.5) (* d 0.208)))
       )
[color="red"](m-ft)[/color]
      )
      (t (princ "\n ** Invalid inputs !! **"))
    )[/color]
...
...