[转贴]：双向标注DZ

ygrzz

;;双向标注DZ
(defun c:ZD (/ hlangue clay pt1 pt2 i osm x1 y1 x2 y2 pt3 pt4)
  (setq clay (getvar "clayer"))
  (if (= (tblobjname "layer" "DIM") nil)
    (progn
      (entmake
        (list
          '(0 . "LAYER")
          '(100 . "AcDbSymbolTableRecord")
          '(100 . "AcDbLayerTableRecord")
          '(70 . 0)
          (cons 6 "CONTINUOUS")
          (cons 62 4)
          (cons 2 "DIM")
        )
      )
    )
  )
  (setvar "clayer" "DIM")
  ;;(setq osm (getvar "osmode"))
  ;;(setvar "osmode" 4)
  (while (setq pt1 (getpoint "\n指定对象点:"))
    (setq pt2 (getpoint pt1 "\n指定标注线对齐点:"))
    (setq x1 (car pt1)
          y1 (cadr pt1)
    )
    (setq x2 (car pt2)
          y2 (cadr pt2)
    )
    (if        (< (abs (- x2 x1)) (* 0.1 (abs (- y2 y1))))
      (command "dimordinate" pt1 pt2)

      (if (< (abs (- y2 y1)) (* 0.1 (abs (- x2 x1))))
        (command "dimordinate" pt1 pt2)
        (progn
          (setq pt3 (list x1 y2))
          (command "dimordinate" pt1 pt3)
          (setq pt3 (list x2 y1))
          (command "dimordinate" pt1 pt3)
        )
      )
    )
  )
  (setvar "osmode" osm)
  (setvar "clayer" clay)
  (princ)
)