[编程交流] 快速dimlinear？

(defun C:DMO (/ diment elist sel)
(prompt "\n\t\t***\tSELECT DIMENSIONS\t***")  
(if 
(setq sel (ssget ":L" (list (cons 0 "DIMENSION"))))
(while (setq diment (ssname sel 0))
 (setq elist (entget diment))
 (entmod (subst (cons 1 "<>CM")(assoc 1 elist) elist))
 (entupd diment)
 (ssdel diment sel)
 )
)
 (princ)
 )
(prompt "\n\t\t***\tType DMO to execute\t***")
(princ)

;;======== rectangles dimensioning ===========;
(defun C:RD (/ coors diment gap hgt p1 p2 p3 p4 pmid1 pmid2
       pmid3 pmid4 px1 px2 px3 px4 sel xmax xmin ymax ymin)
 
(command "_undo" "be")
 
(setq hgt (getvar "dimtxt"))
 (if (zerop hgt)(setq hgt 0.18))
     (setq gap (* hgt 2))
 
(prompt "\n\t\t***\tSelect all rectangles\t***")
(if 
 (setq sel (ssget "_:L" (list (cons 0 "LWPOLYLINE")(cons 90 4)(cons 70 1))))
 (while (setq diment (ssname sel 0))
 (setq coors (vl-remove-if (function not)
      (mapcar
        (function (lambda(x)
        (if (= 10 (car x))
          (cdr x))))
              (entget diment))))
   
(setq xmin (apply 'min (mapcar 'car coors))
     xmax (apply 'max (mapcar 'car coors))
     ymin (apply 'min (mapcar 'cadr coors))
     ymax (apply 'max (mapcar 'cadr coors))
     )
   
(setq p1 (list xmin ymin)
     p2 (list xmax ymin)
     p3 (list xmax ymax)
     p4 (list xmin ymax)
     
     pmid1 (mapcar (function (lambda(a b)(/ (+ a b) 2))) p1 p2)
     px1 (polar pmid1 (+ (angle p1 p2)(/ pi 2)) gap)
     pmid2 (mapcar (function (lambda(a b)(/ (+ a b) 2))) p2 p3)
     px2 (polar pmid2 (+ (angle p2 p3)(/ pi 2)) gap)
     pmid3 (mapcar (function (lambda(a b)(/ (+ a b) 2))) p3 p4)
     px3 (polar pmid3 (+ (angle p3 p4)(/ pi 2)) gap)
     pmid4 (mapcar (function (lambda(a b)(/ (+ a b) 2))) p4 p1)
     px4 (polar pmid4 (+ (angle p4 p1)(/ pi 2)) gap)
     )
   
(command "_dimlinear" "_non" p1  "_non" p2  "_non" px1)
   (vl-cmdf "dimoverride" "dimpost" "CM" "" "L" "")
;;;(command "_dimlinear"  "_non" p2  "_non" p3  "_non" px2)
;;;    (vl-cmdf "dimoverride" "dimpost" "CM" "" "L" "")    
;;;(command "_dimlinear"  "_non" p3  "_non" p4  "_non" px3)
;;;    (vl-cmdf "dimoverride" "dimpost" "CM" "" "L" "")
(command "_dimlinear"  "_non" p1  "_non" p4  "_non" px4)
(vl-cmdf "dimoverride" "dimpost" "CM" "" "L" "") 
   (ssdel diment sel)
 )
 )
(command "_undo" "e")
 (princ)
 )
(prompt "\n\t\t***\tType RD to execute\t***")
(princ)

(defun C:PolyD
      (/ ENT_PL INT_COUNT INT_POS LST_PTS REAL_DS SS_PL
;Subs
)
  (setvar "cmdecho" 0)
  (vl-cmdf "_undo" "be")
  (setq Real_Ds (getvar "DimScale"))
  (if (zerop Real_Ds)
  (setq Real_Ds 1))
  (prompt "\nSelect polyline")
  (while (not (setq SS_Pl (ssget  "_:S" '((0 . "LWPOLYLINE"))))))
  (setq Ent_PL (entget (ssname SS_Pl 0.0)))
  (if (> (cdr (assoc 70 Ent_PL)) 1)(progn(princ "It can not have arc's")(exit)))
  (setq Int_Count 0)
  (setq Int_Pos (vl-position (assoc 10 Ent_PL) Ent_PL))
  (setq Lst_Pts (list (list  (cdr (nth Int_Pos Ent_PL)) (cdr (nth (setq Int_Pos (+ 5 Int_Pos)) Ent_PL)))))
  (while (not (eq (assoc 210 Ent_PL)(nth (+ 5 Int_Pos) Ent_PL)))
   (setq Lst_Pts (append Lst_Pts (list (list  (cdr (nth Int_Pos Ent_PL)) (cdr (nth (setq Int_Pos (+ 5 Int_Pos)) Ent_PL)))))))
;(if (= (cdr (assoc 70 Ent_PL)) 0)
  (setq Lst_Pts (append Lst_Pts (list (list  (cdr (nth Int_Pos Ent_PL)) (car (car Lst_Pts))))))
 
  (foreach Lst_Pair Lst_Pts
  (cond
    ((= (car (car Lst_Pair)) (car (cadr Lst_Pair))) ;Horizonal
     (command "_DIMLINEAR" (car Lst_Pair) (cadr Lst_Pair) (polar (car Lst_Pair) (* pi -0.5 ) (* Real_Ds 10))))
    ((= (cadr (car Lst_Pair))(cadr (cadr Lst_Pair))) ;Vertical
     (command "_DIMLINEAR" (car Lst_Pair) (cadr Lst_Pair) (polar (car Lst_Pair) 0.0 (* Real_Ds 10))))
    (t ; Angled
      (command "_DIMALIGNED"(car Lst_Pair) (cadr Lst_Pair) (polar (car Lst_Pair) (+ (angle (car Lst_Pair) (cadr Lst_Pair) )(* pi -0.5)) (* Real_Ds 10)))
      (command "_DIMLINEAR" (car Lst_Pair) (cadr Lst_Pair) (polar (car Lst_Pair) (* pi -0.5 ) (* Real_Ds 10)))
      (command "_DIMLINEAR" (car Lst_Pair) (cadr Lst_Pair) (polar (car Lst_Pair) 0.0 (* Real_Ds 10)))
     )
  )
)
  (setvar "cmdecho" 1)
  (vl-cmdf "_undo" "end")
 (princ)
)

;;========= rectangle dimensioning ===========;
(defun C:DRE (/ coors en off p1 p2 p3 p4  pmid1 pmid2 pmid3 pmid4
        pt px1 px2 px3 px4 xmax xmin ymax ymin)
 (command "._ucs" "_w")
 (initget 6)
 (setq off (getdist "\nEnter offset distance for dimensions : "))
 ; you can use selection instead here:
;;;  (while (setq ent (entsel "\nSelect rectangle (or press Enter to Exit) >>"))
;;;    (setq en (car ent))
 (while (setq pt (getpoint "\nPick first corner point (or press Enter to Exit) >>"))
 (command "_rectangle" pt pause)
 (setq en (entlast))
 (setq        coors (vl-remove-if
        (function not)
        (mapcar
          (function (lambda (x)
                      (if (= 10 (car x))
                        (cdr x))))
          (entget en))))
 (setq        xmin (apply 'min (mapcar 'car coors))
xmax (apply 'max (mapcar 'car coors))
ymin (apply 'min (mapcar 'cadr coors))
ymax (apply 'max (mapcar 'cadr coors))
)
 (setq        p1    (list xmin ymin)
p2    (list xmin ymax)
p3    (list xmax ymax)
p4    (list xmax ymin)
pmid1 (mapcar (function (lambda (a b) (/ (+ a b) 2))) p1 p2)
px1   (polar pmid1 (+ (angle p1 p2) (/ pi 2)) off)
pmid2 (mapcar (function (lambda (a b) (/ (+ a b) 2))) p2 p3)
px2   (polar pmid2 (+ (angle p2 p3) (/ pi 2)) off)
pmid3 (mapcar (function (lambda (a b) (/ (+ a b) 2))) p3 p4)
px3   (polar pmid3 (+ (angle p3 p4) (/ pi 2)) off)
pmid4 (mapcar (function (lambda (a b) (/ (+ a b) 2))) p4 p1)
px4   (polar pmid4 (+ (angle p4 p1) (/ pi 2)) off)
)
 (command "_dimlinear" "_non" p1 "_non" p2 "_non" px1)
 (command "_dimlinear" "_non" p2 "_non" p3 "_non" px2)
 (command "_dimlinear" "_non" p3 "_non" p4 "_non" px3)
 (command "_dimlinear" "_non" p4 "_non" p1 "_non" px4)
   )
 (command "._ucs" "_p")
 (princ)
 )