杰瑞，
如果将其粘贴到R14中的命令行，会发生什么？
(alert (vl-princ-to-string (+ 1 2 3))) 我确实发现： 感谢您的输入CAB，我还没有包括标志插入，我将稍微修改它，以包括总码数也。
vl函数在14个版本中不起作用，真丢脸，也许有人可以解决它们？ 更新版本：
（但同样，使用一些vl函数…）
; 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
只需添加标志块，这不会花费太多。
我应该为用户创建一个对话框来选择正确的块，还是使用默认的文件路径？ 另一个快速更新-抱歉这里的所有帖子伙计们，
已更新LISP以指示所有vl命令。
; 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
Dave，这是粘贴结果。。。当然感谢大家的帮助。。。杰尔
命令：（警报（vl princ to string（+1 2 3）））
错误或按Esc*取消*
命令：*取消* 李，
真 的！干得好！我真的很感激你所做的一切。它越来越接近我想要它做的事情了。
所附文件将向您显示“码数”文本正从绿色“背面”插入T形三通。因此，码数是相反的。我试图自己纠正它，但没有成功。
我建议在这个时候对甜甜圈进行“评论”，因为我认为他们不会被需要。
正如你所说的，接下来是累计码数和旗杆。我现在没有关于“路径名”标志的答案。稍后我会再打给你。
从长远来看，使用R14，您认为在移动中心线夹点时，是否可以使用VBA反应器自动更新“码数文本”？
非常感谢您和其他做出贡献的人。
杰瑞
布局示例6。图纸 太糟糕了，vl函数不能工作。
见附件李的例行程序的修订版本。
我添加了标志，它必须存在于此版本的DWG中。
还去掉了甜甜圈。
我会复习你的新图纸。
高尔夫CL李。LSP
页:
1
[2]