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

David Bethel · 发表于 2022-7-6 15:50:57

我认为R14中没有任何（vl）函数可用。我认为它们是在A2K中引入的-大卫

CAB · 发表于 2022-7-6 15:55:18

谢谢大卫。

杰瑞，
如果将其粘贴到R14中的命令行，会发生什么？

(alert (vl-princ-to-string (+ 1 2 3)))

CAB · 发表于 2022-7-6 15:58:36

我确实发现：

Lee Mac · 发表于 2022-7-6 16:01:40

感谢您的输入CAB，我还没有包括标志插入，我将稍微修改它，以包括总码数也。

vl函数在14个版本中不起作用，真丢脸，也许有人可以解决它们？

Lee Mac · 发表于 2022-7-6 16:05:25

更新版本：

（但同样，使用一些vl函数…）

copy


 ; 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 lastxt txtval)
   
 ;     --- 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 ---
   (or (getenv "GOLF:OFF") (setenv "GOLF:OFF" "125"))
   (or (getenv "GOLF:TEXT") (setenv "GOLF:TEXT" "30.0"))
   (or (getenv "GOLF:LTSCALE") (setenv "GOLF:LTSCALE" "300"))
   (alert (strcat "Type "GOLFSET" to Alter Base Variables \nCurrent Settings: \nText Offset: "
          (getenv "GOLF:OFF")
          "\nText Height: "
          (getenv "GOLF:TEXT")
          "\nLine-Type Scale: "
          (getenv "GOLF:LTSCALE")
      ) ;_  end strcat
   ) ;_  end alert
   (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" (getenv "GOLF:LTSCALE") "")
   (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)
   (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 (atof (getenv "GOLF:OFF"))))
       (maketext pt (rtos (nth xth dislist) 2 0))
       (command "_chprop" (entlast) "" "C" "BYLAYER" "")
       (setq xth (1+ xth))
       ) ;_  end foreach
   ) ;_  end progn
   ) ;_  end if
   (setq lastxt (entget (entlast)))
   (setq txtval (cdr (assoc 1 lastxt)))
   (setq lastxt (subst (cons 1 (strcat txtval "/" (rtos totyrd 2 0))) (assoc 1 lastxt) lastxt))
   (entmod lastxt)
   (*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 (atof (getenv "GOLF:TEXT")))
         (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
(defun c:golfset (/ goff gtxt glt)
   
   (or (getenv "GOLF:OFF") (setenv "GOLF:OFF" "125"))
   (or (getenv "GOLF:TEXT") (setenv "GOLF:TEXT" "30.0"))
   (or (getenv "GOLF:LTSCALE") (setenv "GOLF:LTSCALE" "300"))
   
   (alert (strcat "Current Settings: \nText Offset: "
          (getenv "GOLF:OFF")
          "\nText Size: "
          (getenv "GOLF:TEXT")
          "\nLine-Type Scale: "
          (getenv "GOLF:LTSCALE")
      ) ;_  end strcat
   ) ;_  end alert
   (if    (setq goff (getreal (strcat "\nSpecify Text Offset <"
                   (getenv "GOLF:OFF")
                   "> : "
               ) ;_  end strcat
          ) ;_  end getreal
   ) ;_  end setq
   (setenv "GOLF:OFF" (rtos goff))
   ) ;_  end if
   (if    (setq gtxt (getreal (strcat "\nSpecify Text Height <"
                   (getenv "GOLF:TEXT")
                   "> : "
               ) ;_  end strcat
          ) ;_  end getreal
   ) ;_  end setq
   (setenv "GOLF:TEXT" (rtos gtxt))
   ) ;_  end if
   (if    (setq glt (getreal (strcat "\nSpecify Line-Type Scale <"
                  (getenv "GOLF:LTSCALE")
                  "> : "
              ) ;_  end strcat
         ) ;_  end getreal
   ) ;_  end setq
   (setenv "GOLF:LTSCALE" (rtos glt))
   ) ;_  end if
   (princ "\nBase Variables Set.")
   (princ)
) ;_  end defun

Lee Mac · 发表于 2022-7-6 16:09:32

只需添加标志块，这不会花费太多。

我应该为用户创建一个对话框来选择正确的块，还是使用默认的文件路径？

Lee Mac · 发表于 2022-7-6 16:11:19

另一个快速更新-抱歉这里的所有帖子伙计们，

已更新LISP以指示所有vl命令。

copy


 ; Golf by Lee McDonnell  ~  28/12/2008
 ; Credit to David Bethel for Polyline Vertex Code
(defun c:golf (/ *error* varLst oldVars pl nlist plvert dislist totyrd anglist ptslist lastxt txtval)
   
 ;     --- 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 ---
   (or (getenv "GOLF:OFF") (setenv "GOLF:OFF" "125"))
   (or (getenv "GOLF:TEXT") (setenv "GOLF:TEXT" "30.0"))
   (or (getenv "GOLF:LTSCALE") (setenv "GOLF:LTSCALE" "300"))
   (alert (strcat "Type "GOLFSET" to Alter Base Variables \nCurrent Settings: \nText Offset: "
          (getenv "GOLF:OFF")
          "\nText Height: "
          (getenv "GOLF:TEXT")
          "\nLine-Type Scale: "
          (getenv "GOLF:LTSCALE")
      ) ;_  end strcat
   ) ;_  end alert
   (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" (getenv "GOLF:LTSCALE") "")    
   (setq plvert (massoc 10 (entget pl)))
   (Pointer plvert)
   (pdist plvert)
   (setq totyrd (/ (apply '+ dislist) 3))
   (setq dislist (mapcar '(lambda (x) (/ x 3)) dislist))
   (pangs plvert)
   (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 (atof (getenv "GOLF:OFF"))))
       (maketext pt (rtos (nth xth dislist) 2 0))
       (command "_chprop" (entlast) "" "C" "BYLAYER" "")
       (setq xth (1+ xth))
       ) ;_  end foreach
   ) ;_  end progn
   ) ;_  end if
   (setq lastxt (entget (entlast)))
   (setq txtval (cdr (assoc 1 lastxt)))
   (setq lastxt (subst (cons 1 (strcat txtval "/" (rtos totyrd 2 0))) (assoc 1 lastxt) lastxt))
   (entmod lastxt)
   (*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 (atof (getenv "GOLF:TEXT")))
         (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
(defun massoc (key alist)
   (foreach x alist
   (if (eq key (car x))
       (setq nlist (cons (cdr x) nlist))
   ) ;_  end if
   ) ;_  end foreach
   (reverse nlist)
) ;_  end defun
(defun c:golfset (/ goff gtxt glt)
   
   (or (getenv "GOLF:OFF") (setenv "GOLF:OFF" "125"))
   (or (getenv "GOLF:TEXT") (setenv "GOLF:TEXT" "30.0"))
   (or (getenv "GOLF:LTSCALE") (setenv "GOLF:LTSCALE" "300"))
   
   (alert (strcat "Current Settings: \nText Offset: "
          (getenv "GOLF:OFF")
          "\nText Size: "
          (getenv "GOLF:TEXT")
          "\nLine-Type Scale: "
          (getenv "GOLF:LTSCALE")
      ) ;_  end strcat
   ) ;_  end alert
   (if    (setq goff (getreal (strcat "\nSpecify Text Offset <"
                   (getenv "GOLF:OFF")
                   "> : "
               ) ;_  end strcat
          ) ;_  end getreal
   ) ;_  end setq
   (setenv "GOLF:OFF" (rtos goff))
   ) ;_  end if
   (if    (setq gtxt (getreal (strcat "\nSpecify Text Height <"
                   (getenv "GOLF:TEXT")
                   "> : "
               ) ;_  end strcat
          ) ;_  end getreal
   ) ;_  end setq
   (setenv "GOLF:TEXT" (rtos gtxt))
   ) ;_  end if
   (if    (setq glt (getreal (strcat "\nSpecify Line-Type Scale <"
                  (getenv "GOLF:LTSCALE")
                  "> : "
              ) ;_  end strcat
         ) ;_  end getreal
   ) ;_  end setq
   (setenv "GOLF:LTSCALE" (rtos glt))
   ) ;_  end if
   (princ "\nBase Variables Set.")
   (princ)
) ;_  end defun

JWeyer · 发表于 2022-7-6 16:13:51

Dave，这是粘贴结果。。。当然感谢大家的帮助。。。杰尔

命令：（警报（vl princ to string（+1 2 3）））
错误或按Esc*取消*
命令：*取消*

JWeyer · 发表于 2022-7-6 16:18:00

李，

真的！干得好！我真的很感激你所做的一切。它越来越接近我想要它做的事情了。

所附文件将向您显示“码数”文本正从绿色“背面”插入T形三通。因此，码数是相反的。我试图自己纠正它，但没有成功。

我建议在这个时候对甜甜圈进行“评论”，因为我认为他们不会被需要。

正如你所说的，接下来是累计码数和旗杆。我现在没有关于“路径名”标志的答案。稍后我会再打给你。

从长远来看，使用R14，您认为在移动中心线夹点时，是否可以使用VBA反应器自动更新“码数文本”？

非常感谢您和其他做出贡献的人。

杰瑞
布局示例6。图纸

CAB · 发表于 2022-7-6 16:20:14

太糟糕了，vl函数不能工作。

见附件李的例行程序的修订版本。
我添加了标志，它必须存在于此版本的DWG中。
还去掉了甜甜圈。

我会复习你的新图纸。
高尔夫CL李。LSP

[编程交流] 自动绘制标签距离（&A）

发表回复

精选推荐