社区 › Auto Lisp › 自动绘制标签距离（&A）

JWeyer 发表于 2022-7-6 15:19:02

自动绘制标签距离（&A）

（由作者从二维绘图移到…）
 
以下方法可行吗？
 
使用AutoCAD R14或2004，我希望能够绘制建议的高尔夫球洞中心线，每个洞有多达四个点。
 
“Pt0”将是一个“左键点击”，以指示拟议孔中心线的“起点”（后三通）。。。
“Pt1”将是一个“左键点击”，以指示第一个“着陆区”（或“绿色位置”，如果拟议的洞是“3号杆”）。。。
“Pt2”将是一个“左键点击”，以指示第二个“着陆区”（或“绿色位置”，如果这个拟议的洞是“4杆洞”）。。。
“Pt3”将是一个“左键点击”来指示最终目标，如果这个提议的洞是“5杆洞”。（无6杆）。。。
在最后一点，无论是“Pt1”、“Pt2”还是“Pt3”，都会插入一个“Flag_块”来指示拟议的绿色位置。
 
希望在拟议的中心线向所需方向拉伸时，将显示一个活动的文本框窗口，指示以“码”和“总码”为单位的距离。当“Pt1”抓地力建立时，“码”将自动标记在“Pt1”抓地力附近。“Pt2”和“Pt3”也是如此。
 
“最后一点”无论是“Pt1”、“Pt2”还是“Pt3”，也将显示该特定孔的“总码数”。文本标签格式可以是这样的：Pt1:[码]，对于点2和3:[码/总码]
 
最后，如果选择并重新定位任何当前夹点，“所有”当前孔距离将自动实时更新。
 
预编程层、线型、颜色、比例和线宽也将包含在该例程中。（见附图。）
 
在R14/R2004中，是否已有任何可以修改的内容来完成上述部分或全部工作？
 
（我目前使用R14，但由于Vista兼容性问题，打算改用R2004。）
 
谢谢
布局示例3。图纸

Lee Mac 发表于 2022-7-6 15:23:16

在回答你的问题：“这可行吗？”，
 
我想说，只要提供了必要的块文件路径等，就可以复制线程中发布的图表。然而，要有一个实时更新的文本框需要很多，所以我认为您可能不得不满足于一些不完全符合您的确切规格的东西。

CAB 发表于 2022-7-6 15:26:42

很可行。收集点的用户输入&插入标志块并放置
带距离的文本很容易用简单的lisp例程完成。
更新文本需要使用反应堆。这也是可行的，但需要
比第一个lisp编程多一点。

CAB 发表于 2022-7-6 15:29:54

只是看了一下你的图纸。我的观察结果：
奇怪的是，标志块的Z值为840。有什么原因吗？
该标志的比例为0.5。旋转是任意的吗？
块的插入点位于旗杆的中间。这也让我感到奇怪。
以脚作为基本绘图单位进行绘制。
使用柱脚线作为中心线。
线型设置为300作为比例。
看起来您使用了“圆环”命令添加了标记中心线顶点的柱脚。
 
你有Lisp程序的经验吗？

Lee Mac 发表于 2022-7-6 15:32:15

哎呀，出租车，你真的把它摔成碎片了！
 
使用反应器是一个好主意，尽管让ACAD知道应对哪些抓握动作本身就是一项任务！
 
至于问题的另一半，我认为这是非常可行的，但正如你所说的，如果标志的基点位于PLINE的端点，问题会变得容易得多。

Lee Mac 发表于 2022-7-6 15:37:28

这是一个开始：
 

; Golf by Lee McDonnell~28/12/2008

; Credit to ASMI for Polyline Vertex Code


(defun c:golf (/ *error* varLst oldVars)
;   --- Error Trap ---

   (defun *error* (msg)
   (mapcar 'setvar varLst oldVars)
   (if (= msg "")
       (princ "\nFunction Complete.")
       (princ "\nError or Esc pressed... ")
   ) ;_end if
   (princ)
   ) ; end of *error*

   (setq varLst(list "CMDECHO" "CLAYER")
   oldVars (mapcar 'getvar varLst)
   ) ; end setq

;    --- Error Trap ---

   (setvar "cmdecho" 0)
   (mapcar 'makelay
       '("DESIGN-PROP-CTR-LINES"
         "DESIGN-PROP-CTR-LINES-POINTS"
         "DESIGN-PROP-CTR-LINES-FLAGS"
         "DESIGN-PROP-CTR-LINES-YARDS"
      )
   ) ;_end mapcar
   (setvar "clayer" "DESIGN-PROP-CTR-LINES")
   (prompt "\nConsruct Polyline: ")
   (command "_pline")
   (while (> (getvar "cmdactive") 0) (command pause))
   (setq pl (entlast))
   (command "_pedit" pl "w" "1.0" "")
   (command "_chprop" pl "" "C" "BYLAYER" "LT" "AG-CENTER" "S" "300" "")
   (Pointer pl)
   (*error* "")
   (princ)
) ;_end defun

(defun Pointer (ent / plvert don)
   (setq plvert (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget ent))))
   (setvar "clayer" "DESIGN-PROP-CTR-LINES-POINTS")
   (foreach coord plvert
   (command "_donut" "0" "20" coord "")
   (setq don (entlast))
   (command "_chprop" don "" "C" "BYLAYER" "")
   ) ;_end foreach
) ;_end defun

(defun makelay (x)
   (if    (not (tblsearch "Layer" x))
   (command "-layer" "m" x "")
   (setvar "clayer" x)
   ) ;_end if
) ;_end defun

JWeyer 发表于 2022-7-6 15:38:11

谢谢李和其他人的帮助和评论。它像我希望的那样工作。
 
我附上了一个更新的绘图文件，它更正了旗杆的插入点。标志的标高虽然不重要，但已设置为“0”。
 
现在可以将标志旋转设置为“0”。我不知道是否可以开发一个例程来考虑与“文本”和“中心线”的所有可能冲突。
 
除中心线外，通常用于高尔夫球场设计的测量单位为英尺。
 
当建筑师正在拉伸拟议的中心线时，能够看到“庭院”将非常有用。（也许我不得不等到切换到R2004。）
 
我现在也去掉了甜甜圈。我认为应该用“某物”来识别转折点。但我不确定在这一点上是什么。
 
正如你可能知道的，我没有受过CAD或lisp方面的正式培训。非常感谢您的任何帮助或意见。。。
 
谢谢，杰瑞
 
P、 我不知道下面的代码是否有任何帮助，但我发现了一些东西，并对其进行了修改，以确定拟议高尔夫洞的“总跑码”。我希望看到这种情况发生，并显示在某处，因为建筑师正在绘制拟议的中心线和“距离标签”插入到每个“左”点击。
 
+++++++++++++++++++++++++
 
;跑码距离计算器
（定义c：跑道（/pt1 pt2 pt3 pt4 d1 d2 d3 d4 ty y1 y2 y3）
（图表）
（setvar“CMDECHO”0）
（setq pt1（getpoint“Pick Tee”）（ERPI）
（setq pt2（getpoint“Pick Landing Area”pt1））（ERPI）
（setq d1（距离pt1 pt2））
（setq y1（/d1 3））
（提示符“1st shot=”）（提示符（rtos y1 2 0））（提示符“Yards，”）
 
（setq pt3（getpoint“下一个着陆区”pt2））（ERPRI）
（setq d2（距离pt2 pt3））
（setq y2（/d2 3））
（setq ty（+y1 y2））
（提示“1st Shot=”）（提示（rtos y1 2 0））（提示“Yards”）
（提示符“2nd Shot=”）（提示符（rtos y2 2 0））（提示符“Yards，”）
（提示符“=”）（提示符（rtos ty 2 0））（提示符“Yards，”）
（setq pt4（getpoint“3rd Shot”pt3））（ERPI）
（setq d3（距离pt3 pt4））
（setq y3（/d3 3））
（setq ty（+y1 y2 y3））
（提示符“1st Shot=”）（提示符（rtos y1 2 0））（提示符“Yards，”）
（提示符“2nd Shot=”）（提示符（rtos y2 2 0））（提示符“Yards，”）
（提示符“3rd Shot=”）（提示符（rtos y3 2 0））（提示符“Yards，”）
（提示“=”）（提示（rtos ty 2 0））（提示“总计”）
（普林斯）
)
 
++++++++++++++++++++
布局示例4。图纸

Lee Mac 发表于 2022-7-6 15:41:16

我已经更新了我的上一个例程：
 
看看这是否有帮助：
 

; Golf by Lee McDonnell~28/12/2008

; Credit to ASMI for Polyline Vertex Code


(defun c:golf (/ *error* varLst oldVars pl plvert dislist totyrd anglist ptslist)
;   --- Error Trap ---

   (defun *error* (msg)
   (mapcar 'setvar varLst oldVars)
   (if (= msg "")
       (princ "\nFunction Complete.")
       (princ "\nError or Esc pressed... ")
   ) ;_end if
   (princ)
   ) ; end of *error*

   (setq varLst(list "CMDECHO" "CLAYER")
   oldVars (mapcar 'getvar varLst)
   ) ; end setq

;    --- Error Trap ---

   (setvar "cmdecho" 0)
   (mapcar 'makelay
       '("DESIGN-PROP-CTR-LINES"
         "DESIGN-PROP-CTR-LINES-POINTS"
         "DESIGN-PROP-CTR-LINES-FLAGS"
         "DESIGN-PROP-CTR-LINES-YARDS"
      )
   ) ;_end mapcar
   (setvar "clayer" "DESIGN-PROP-CTR-LINES")
   (prompt "\nConsruct Polyline: ")
   (command "_pline")
   (while (> (getvar "cmdactive") 0) (command pause))
   (setq pl (entlast))
   (command "_pedit" pl "w" "1.0" "")
   (command "_chprop" pl "" "C" "BYLAYER" "LT" "AG-CENTER" "S" "300" "")
   (setq plvert (mapcar 'cdr (vl-remove-if '(lambda (x) (/= 10 (car x))) (entget pl))))
   (Pointer plvert)
   (pdist plvert)
   (setq totyrd (/ (apply '+ dislist) 3))
   (setq dislist (mapcar '(lambda (x) (/ x 3)) dislist))
   (pangs plvert)
   (alert (vl-princ-to-string anglist))
   (setq anglist (mapcar '(lambda (x) (+ x (/ pi 2))) anglist))
   (setq ptslist (cdr plvert))
   (if    (= (length anglist) (length ptslist))
   (progn
       (setq xth 0)
       (foreach x anglist
       (setq pt (polar (nth xth ptslist) x 125))
       (maketext pt (rtos (nth xth dislist) 2 0))
       (command "_chprop" (entlast) "" "C" "BYLAYER" "")
       (setq xth (1+ xth))
       ) ;_end foreach
   ) ;_end progn
   ) ;_end if
   (*error* "")
   (princ)
) ;_end defun

(defun Pointer (entlist / don)
   (setvar "clayer" "DESIGN-PROP-CTR-LINES-POINTS")
   (foreach coord entlist
   (command "_donut" "0" "20" coord "")
   (setq don (entlast))
   (command "_chprop" don "" "C" "BYLAYER" "")
   ) ;_end foreach
) ;_end defun

(defun makelay (x)
   (if    (not (tblsearch "Layer" x))
   (command "-layer" "m" x "")
   (setvar "clayer" x)
   ) ;_end if
) ;_end defun

(defun pdist (entlist1 / index len dis)
   (setq index    0
   len    (length entlist1)
   ) ;_end setq
   (while (< index (1- len))
   (setq dis
             (distance    (nth index entlist1)
               (nth (1+ index) entlist1)
             ) ;_end distance
         dislist (cons dis dislist)
         index   (1+ index)
   ) ;_end setq
   ) ;_end while
   (princ)
) ;_end defun

(defun maketext    (x y)
   (entmake
   (list '(0 . "TEXT")
         '(8 . "DESIGN-PROP-CTR-LINES-YARDS")
         (cons 10 x)
         (cons 40 30.0)
         (cons 1 y)
         '(50 . 0.0)
         '(7 . "STANDARD")
         '(71 . 0)
         '(72 . 1)
         '(73 . 2)
         (cons 11 x)
   ) ; end list
   ) ; end entmake
) ;_end defun

(defun pangs (entlist2 / len1 index1 ang)
   (setq index1 0
   len1   (length entlist2)
   ) ;_end setq
   (while (< index1 (1- len1))
   (setq ang
             (angle (nth index1 entlist2)
                (nth (1+ index1) entlist2)
             ) ;_end distance
         anglist (cons ang anglist)
         index1(1+ index1)
   ) ;_end setq
   ) ;_end while
   (princ)
) ;_end defun

JWeyer 发表于 2022-7-6 15:44:53

李，
 
感谢您对拟议日程的更新。。。
 
使用您的更新，即随附文件，显示在使用最新版本时绘制的拟议孔中心线（新中心线以洋红色显示）。
 
我看不出结果有什么不同。可能是因为我使用的是R14，而您使用的是最新版本的AutoCAD吗？
 
我真的很感谢你的帮助和兴趣。
 
谢谢
杰瑞
布局示例5。图纸

CAB 发表于 2022-7-6 15:50:18

刚刚在ACAD2k中尝试了李的套路&它奏效了，所以可能有14个。
我看到李还没有添加标志块插入。但在我的测试中，课文很好。

查看完整版本: 自动绘制标签距离（&A）