[编程交流] 自动标注尺寸

(defun C:test (/ elist en p1 p2 pc ss)
 (setvar "osmode" 0)
(command "_.zoom" "_e")
(setq ss (ssget "_X" (list (cons 0  "LINE"))))
(setq i -1)
(while
 (setq en (ssname ss (setq i (1+ i))))
 (setq elist (entget en))
 (setq p1 (cdr (assoc 10 elist))
p2 (cdr (assoc 11 elist))
pc (mapcar (function (lambda(a b)(/ (+ a b) 2))) p1 p2)
)
 (entmake (list (cons 0 "DIMENSION")
   (cons 100  "AcDbEntity")
   (cons 67 0)         
   (cons 410  "Model")
   (cons 8  "ZONE1")
   (cons 100  "AcDbDimension")
   (cons 2  "*D0")
   (cons 10 (trans (list (car p2)(cadr p2) 0.0) 1 0))
   (cons 11 (trans (list (car pc)(cadr pc) 0.0) 1 0))
   (cons 12 (list 0. 0. 0.))
   (cons 6  "Continuous")
   (cons 62 2)
   (cons 70  33)
   (cons 1  "")
   (cons 71  5)
   (cons 72  1)
   (cons 41  1.0)
   (cons 42  (distance p1 p2))
   (cons 52 0)
   (cons 53 0)
   (cons 54  0)
   (cons 3  "Standard")
   (cons 100  "AcDbAlignedDimension")
   (cons 13 (trans (list (car p1)(cadr p1) 0.0) 1 0))
   (cons 14 (trans (list (car p2)(cadr p2) 0.0) 1 0))
   (cons 15 (list 0. 0. 0.))
   (cons 16 (list 0. 0. 0.))
  )
)
 )
(alert "Look at this, what's wrong?")
(princ)
 )
(C:test)
(alert "There are all dims at the same point, what a ...???")

(defun C:test (/ elist en p1 p2 pc ss)
 (setvar "osmode" 0)
(command "_.zoom" "_e")
(setq ss (ssget "_X" (list (cons 0  "LINE"))))
(setq i -1)
(while
 (setq en (ssname ss (setq i (1+ i))))
 (setq elist (entget en))
 (setq p1 (cdr (assoc 10 elist))
p2 (cdr (assoc 11 elist))
pc (mapcar (function (lambda(a b)(/ (+ a b) 2))) p1 p2)
)
 (entmake (list (cons 0 "DIMENSION")
   (cons 100  "AcDbEntity")
   (cons 67 0)         
   (cons 410  "Model")
   (cons 8  "ZONE1")
   (cons 100  "AcDbDimension")
   (cons 10 (trans (list (car p2)(cadr p2) 0.0) 1 0))
   (cons 11 (trans (list (car pc)(cadr pc) 0.0) 1 0))
   (cons 12 (list 0. 0. 0.))
   (cons 6  "Continuous")
   (cons 62 2)
   (cons 70  33)
   (cons 1  "")
   (cons 71  5)
   (cons 72  1)
   (cons 41  1.0)
   (cons 42  (distance p1 p2))
   (cons 52 0)
   (cons 53 0)
   (cons 54  0)
   (cons 3  "Standard")
   (cons 100  "AcDbAlignedDimension")
   (cons 13 (trans (list (car p1)(cadr p1) 0.0) 1 0))
   (cons 14 (trans (list (car p2)(cadr p2) 0.0) 1 0))
   (cons 15 (list 0. 0. 0.))
   (cons 16 (list 0. 0. 0.))
  )
)
 )
(alert "Done?")
(princ)
 )

 Public Sub DimAlignAll()
 Dim oAcEntity As AcadEntity
   'use the current drawing thats open
   For Each oAcEntity In ThisDrawing.ModelSpace
     Select Case oAcEntity.ObjectName
       Case "AcDbLine"
         Dim oAcLine As AcadLine
         Set oAcLine = oAcEntity
         Dim aTxtPt(2) As Double
         aTxtPt(0) = oAcLine.StartPoint(0)
         aTxtPt(1) = oAcLine.StartPoint(1)
         With ThisDrawing.ModelSpace.AddDimAligned(oAcLine.StartPoint, oAcLine.EndPoint, aTxtPt)
           .Update
         End With
     End Select
   Next
 End Sub