填充单个线
我公司从事船舶维修行业，我们处理的标准图纸类型是系统成熟度图纸。通常情况下，我们会获取原始安装图，然后在新图纸中通过在代表任何必须移除的线上绘制图案填充出相关设备和电缆。我曾经工作过的公司使用了一个内部开发的AutoCAD附加组件（由VLISP Bible的作者David Stein开发），它有一个行填充命令。这个命令的使用非常有益，尤其是在大型图纸上。我最近开始编写自己的lisp来实现同样的目标，下面的代码就是我想到的。
代码运行得很好，我只是知道，由于我不是最高效的代码编写者，可能有很多方法可以改进它。如果有任何建议或建设性的批评，我将不胜感激。
(defun *error* ( msg )
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n ** ERROR: " msg " **")))
(setq ssline nil)
(princ)
)
(defun c:autohatch ( / ssline lineobj PtLst ptx1 ptx2 pty1 pty2 )
(defun hatch_vert_line ( / x1 x2 x3 x4 )
(setq x1 (- ptx1 0.1))
(setq x2 (+ ptx1 0.1))
(setq x3 (+ ptx2 0.1))
(setq x4 (- ptx2 0.1))
(entmakex
(list
(cons 0 "HATCH")
(cons 100 "AcDbEntity")
(cons 8 "0")
(cons 100 "AcDbHatch")
(cons 62 256)
(cons 10 (list 0.0 0.0 0.0))
(cons 210 (list 0.0 0.0 1.0))
(cons 2 "ANSI31")
(cons 70 1)
(cons 71 0)
(cons 91 1)
(cons 92 1)
(cons 93 4)
(cons 72 1)
(cons 10 (list x1 pty1 0))
(cons 11 (list x2 pty1 0))
(cons 72 1)
(cons 10 (list x2 pty1 0))
(cons 11 (list x3 pty2 0))
(cons 72 1)
(cons 10 (list x3 pty2 0))
(cons 11 (list x4 pty2 0))
(cons 72 1)
(cons 10 (list x4 pty2 0))
(cons 11 (list x1 pty1 0))
(cons 97 0)
(cons 75 2)
(cons 76 1)
(cons 98 1)
(cons 10 (list 0.0 0.0 0.0))
)
)
(setq ssline nil)
)
(defun hatch_horiz_line ( / y1 y2 y3 y4 )
(setq y1 (- pty1 0.1))
(setq y2 (+ pty1 0.1))
(setq y3 (+ pty2 0.1))
(setq y4 (- pty2 0.1))
(entmakex
(list
(cons 0 "HATCH")
(cons 100 "AcDbEntity")
(cons 8 "0")
(cons 100 "AcDbHatch")
(cons 62 256)
(cons 10 (list 0.0 0.0 0.0))
(cons 210 (list 0.0 0.0 1.0))
(cons 2 "ANSI31")
(cons 70 1)
(cons 71 0)
(cons 91 1)
(cons 92 1)
(cons 93 4)
(cons 72 1)
(cons 10 (list ptx1 y1 0))
(cons 11 (list ptx1 y2 0))
(cons 72 1)
(cons 10 (list ptx1 y2 0))
(cons 11 (list ptx2 y3 0))
(cons 72 1)
(cons 10 (list ptx2 y3 0))
(cons 11 (list ptx2 y4 0))
(cons 72 1)
(cons 10 (list ptx2 y4 0))
(cons 11 (list ptx1 y1 0))
(cons 97 0)
(cons 75 2)
(cons 76 1)
(cons 98 1)
(cons 10 (list 0.0 0.0 0.0))
)
)
(setq ssline nil)
)
(while
(not (setq ssline (ssget ":S" '((0 . "LINE")))))
)
(setq lineobj (vlax-ename->vla-object (ssname ssline 0)))
(vla-getboundingbox lineobj 'MinPt 'MaxPt)
(setq PtLst (cons (vlax-safearray->list MinPt) PtLst))
(setq PtLst (cons (vlax-safearray->list MaxPt) PtLst))
(setq ptx1 (car (car PtLst)))
(setq pty1 (cadr (car PtLst)))
(setq ptx2 (car (cadr PtLst)))
(setq pty2 (cadr (cadr PtLst)))
(cond
((equal ptx1 ptx2 0.001) (hatch_vert_line))
((equal pty1 pty2 0.001) (hatch_horiz_line))
(T (alert "Please pick a vertical or horizontal line."))
)
(c:autohatch)
)自动图案填充。LSP 我的一次老尝试可以在这里找到。
李
编辑：哎呀！看看你的代码，我想我误解了这个帖子。。。 该程序实际上只填充水平线或垂直线。请参阅下面的图片，以比较我所说的内容。
是的，我完全错了，哈哈 我想我应该试试命令版本。
(defun c:hatchl (/ ss en ed p10 p11 h10 h11 h12 h13)
(and (setq ss (ssget '((0 . "LINE"))))
(while (setq en (ssname ss 0))
(setq ed (entget en)
p10 (cdr (assoc 10 ed))
p11 (cdr (assoc 11 ed))
h10 (polar p10 (+ (angle p10 p11) (* pi0.5)) 0.1)
h11 (polar p10 (+ (angle p10 p11) (* pi -0.5)) 0.1)
h12 (polar p11 (+ (angle p11 p10) (* pi0.5)) 0.1)
h13 (polar p11 (+ (angle p11 p10) (* pi -0.5)) 0.1))
(command "_.HATCH" "ANSI31" 1 0 "" "N" h10 h11 h12 h13 h10 "" "")
(ssdel en ss)))
(prin1))
多年来，哈奇的一切似乎都没有真正的一致性。
可能需要解决CLAYER、CECOLOR ans以及错误陷阱。您也可以调整线条角度。
我的0.02美元-David 大概
(if (equal (rem (angle p10 p11) (* pi 0.5)) 0 1e-
(command "_.HATCH"....)
)
对于正交线
大卫，
谢谢你的建议，但这段代码对我不起作用。我收到消息“无法填充边界”
由于李误解了我在做什么，也许我对我的代码做什么不够清楚。我试图通过检索线的点来填充单独的线，以此为基础，通过entmakex创建一个图案填充，该图案填充将在线的每一侧以0.1”的距离覆盖线。 明白我说的不一致是什么意思吗。命令版本可能再次更改（自a2k以来）。我知道dxf代码也发生了很大的变化。
我想我理解这种情况。ansi31图案填充，比例1，角度0，2点线路径，边界点4，无边界。这应该是一件简单的事情，但当autodesk完成它时，它将变得炙手可热。
-大卫 这是2009年-hatch的序列：
-图案填充
P（属性）
ANSI31
1.0（比例）
0.0（角度）
W代表（绘制边界）
N表示（保留多段线边界？）
PT1
PT2
...
PTN公司
C（关闭）
“”（接受）
""
所以我想命令行代码应该是：
(command "-hatch" "P" "ANSI31" "1" "0" "W" "N" pt1 pt2 pt3 pt4 "C" "" "")
编辑：
确认，这一行使用我的代码代替entmakex。所以我只是好奇，为什么你认为在这种情况下命令会比entmakex更好？
朗尼，
以下是使用Express Tools Make linetype创建的线型。该文件称为Hatch。林。它使用文本形状/在其中。您可以使用ltscale进行调整。
见附件。
孵出拉链
页:
[1]
2