社区 › Auto Lisp › 自动标注尺寸

iain9876 发表于 2022-7-5 16:58:53

自动标注尺寸

大家好，
有人知道一个自动标注尺寸线的例程吗。
在我的例子中，这些线是一个二维三角形网格。
我已经尝试过qdim命令，不幸的是，这不适合，因为每条线都必须单独标注尺寸，而且qdim主要用于线性DIM，这不是我想要的。
 
有人见过或知道这样的事吗？
 
提前感谢
伊恩

iain9876 发表于 2022-7-5 17:03:27

这是一个二维三角形网格图。
如果有人想编写一个程序，以dimaligned的方式自动标注每条线的尺寸。如果我愿意付现金，我将不胜感激。
 
伊恩
三角网格。图纸

fixo 发表于 2022-7-5 17:05:21

好的，我知道了
明天见
 
~'J'~

fixo 发表于 2022-7-5 17:11:07

要查看问题，请运行以下代码
仅在此图形上从控制台！
（将此代码复制到编辑器中）
我修不好
我只用了2008（英语）
 

(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 7033)
   (cons 1"")
   (cons 715)
   (cons 721)
   (cons 411.0)
   (cons 42(distance p1 p2))
   (cons 52 0)
   (cons 53 0)
   (cons 540)
   (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 ...???")

 
~'J'~

fixo 发表于 2022-7-5 17:14:19

我发现哪里出了错
试试看吧
 

(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 7033)
   (cons 1"")
   (cons 715)
   (cons 721)
   (cons 411.0)
   (cons 42(distance p1 p2))
   (cons 52 0)
   (cons 53 0)
   (cons 540)
   (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)
)

 
~'J'~

iain9876 发表于 2022-7-5 17:17:28

Fixo你太棒了！
那一套为我节省了大量时间。
你有贝宝吗？我知道你什么也没要，但我想你至少应该请我喝一杯。
 
穆霍斯·格雷西亚
伊恩

fixo 发表于 2022-7-5 17:19:40

算了吧，伊恩
下次你会帮助别人
很乐意帮忙，
当做
 
~'J'~

buddygillespie 发表于 2022-7-5 17:23:37

将此VBA子程序添加到acad。dvb并在网格绘制打开的情况下运行。所有尺寸将与每个线条图元对齐。。。只要给我发邮件，你想要多少钱都行。。。英雄联盟
 

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

jessiwilk 发表于 2022-7-5 17:25:20

这是lisp程序吗？命令名是什么？
 
thnks。

SLW210 发表于 2022-7-5 17:28:26

哪一个？
 
fixo的是LISP，buddygillespie的是VBA。

查看完整版本: 自动标注尺寸