lisp例程帮助，添加bl
大家好，我想把块放在多段线上，因为模型是从20米到20米，但20米是水平测量的，使用带有属性的块。
虽然在我看来应该工作，但不明白问题出在哪里。
我绘制了块“COTAL1.DWG”和模型“lg-mc22_00.DWG”
(vl-load-com)
(princ "\n***The command is CS***")
(defun c:CS (/ pct_0 startpt endpt)
(setq acadObject (vlax-get-acad-object))
(setq acadDocument (vlax-get-property acadObject 'ActiveDocument))
(setq mSpace (vlax-get-property acadDocument 'Modelspace))
(setvar "osmode" 32)
(setq pct_0 (getpoint "\nSelect one point on the reference line: "))
(setq Linia_obiect (vlax-ename->vla-object (car (entsel "\nSelect polyline >>"))))
(setq objLength (vlax-curve-getDistAtParam Linia_obiect (vlax-curve-getEndParam Linia_obiect)))
(setq startpt (vlax-curve-getPointAtParam Linia_obiect (vlax-curve-getStartParam Linia_obiect)))
(setq endpt (vlax-curve-getPointAtParam Linia_obiect (vlax-curve-getEndParam Linia_obiect)))
(setq plan_ref (/ (cadr pct_0) 10.0 ))
(setq Dx (car startpt))
(while (< Dx (car endpt))
(setq pct_pe_l_ref
(list (car startpt)
(cadr pct_0)))
(setq Xline (vlax-invoke mSpace 'AddXLine startPt pct_pe_l_ref))
(if
(setq secondpt (vlax-invokeXline 'IntersectWith Linia_obiect 0))
(progn
(setq Dy (/ (- (cadr secondpt) (cadr pct_0)) 10.0 ) )
(command "insert" "C:\\WBLOCK\\COTAL1.DWG" (polar pt 0.0 0.0) 10 10 0 (rtos (+ plan_ref Dy) 2 2)); (vl-cmdf "_.scale" "l" "" startPt dis )
));;; end if
(vla-delete Xline)
(setq Dx (+ Dx20.0 ))
(setq startpt secondpt)
)
(gc)
(princ)
)
COTAL1.DWG
lg-mc22_00。图纸
Cote\U scurgere\U ape v1.2-eng.LSP 为什么不使用Measure或Divide命令来做同样的事情？两者都可以利用块。我不认为有任何禁止使用属性块。 我想添加块，但要插入的距离（20m）必须在x方向上水平测量，与多段线的斜率无关。
每个块的属性表示纵向纵断面中的高程点。
Measure或Divide命令使用两个插入块之间的段长度，但对我来说这是未知的（是可变的）。
常数为水平距离20m。 你是说这些方块的间距不同？
是的，如果看一下我的示例“lg-mc22_00.dwg”，你会看到我想要如何绘制块。 大家好，
我有一个旧的例程，这就是我想要的，但把块放在多段线的每个顶点。
你们可以告诉我怎样改变，把块只放在从20m到20m的顶点上，正如你们在第二个例子中看到的那个样？
我忘了输入代码。
(princ "\n***Type CS***")
(defun c:CS (/ ent i idx pt ss totparam rot)
(setq old_cmdecho (getvar "cmdecho"))
(setq old_osmode (getvar "OSMODE"))
(setq old_clayer (getvar "clayer"))
(setq old_ucsview (getvar "ucsview"))
(setq old_dimzin (getvar "dimzin"))
(setq old_EXPERT (getvar "EXPERT"))
(setq oldcol (getvar "CECOLOR"))
(setq old_error *error*)
(setvar "cmdecho" 0)
(setvar "UCSVIEW" 1)
(setvar "osmode" 32)
(setvar "EXPERT" 4)
(setvar "DIMZIN" 0)
(command "view" "s" "orig")
(defun *error* (msg)
(setvar "osmode" old_osmode)
(setvar "clayer" old_clayer)
(setvar "DIMZIN" old_DIMZIN)
(setvar "EXPERT" old_EXPERT)
(setvar "CECOLOR" oldcol)
(command "view" "s" "orig")
(if (tblsearch "view" "orig")
(progn
(command "view" "r" "orig")
(command "view" "d" "orig")
)
)
(setvar "ucsview" old_ucsview)
(setvar "cmdecho" old_cmdecho)
(if
(/= "function cancelled" msg)
(if
(= msg "quit / exit abort")
(princ)
(princ (strcat "\nerror: " msg))
)
(princ)
)
(setq *error* old_error)
(princ)
)
(if
(= 1 (logand 1 (getvar "undoctl")))
(progn
(command "._undo" "group")
(setq intors t)
)
(set intors nil)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq plan_ref (getreal "\nWhat Bench mark have Pl.ref: "))
(setq pct_0 (getpoint "\nSelect one point on the reference line: "))
(if (setq ss (ssget '((0 . "*POLY*"))))
(progn
(vla-startundomark (vla-get-activedocument (vlax-get-acad-object)))
(setq idx -1)
(while (< (setq idx (1+ idx))(sslength ss))
(setq ent (ssname ss idx))
(setq totparam (fix (vlax-curve-getendparam ent))
i -1
r (getvar "circlerad"))
(if (= r 0.0)
(setq r 1.5)
)
(while (< (setq i (1+ i)) totparam)
(setq pt (vlax-curve-getpointatparam ent i))
(setq Dy (/ (- (cadr pt) (cadr pct_0)) 10.0 ) )
(command "insert" "C:\\WBLOCK\\COTAL1.DWG" (polar pt 0.0 0.0) 10 10 0 (rtos (+ plan_ref Dy) 2 2))
)
(setq pt (vlax-curve-getpointatparam ent (vlax-curve-getendparam ent)))
(setq Dy (/ (- (cadr pt) (cadr pct_0)) 10.0 ) )
(command "insert" "C:\\WBLOCK\\COTAL1.DWG" (polar pt 0.0 0.0) 10 10 0 (rtos (+ plan_ref Dy) 2 2))
)
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if
intors
(progn
(command ".undo" "_end")
(setq intors nil)
)
)
(setvar "osmode" old_osmode)
(setvar "clayer" old_clayer)
(setvar "ucsview" old_ucsview)
(setvar "EXPERT" old_EXPERT)
(setvar "CECOLOR" oldcol)
(setVAR "dimzin" old_dimzin)
(setvar "cmdecho" old_cmdecho)
(gc)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)
)
Cote\u scurgere\u ape v1.4。LSP 这里没有人能帮我吗？ 问题在于您沿多段线按距离计算点
但是你需要沿着X轴计算它们
这是一个快速而肮脏的代码（没有数学）
(princ "\n***Type CS***")
(vl-load-com)
(defun c:CS (/ acsp adoc cnt dy ent ep intors obj oldcol old_clayer
old_cmdecho old_dimzin old_error old_expert old_osmode
old_ucsview p1 p2 pct_0 plan_ref pt sset sp ss xdelta xdist
xend xline xstart yzero)
(setq old_cmdecho (getvar "cmdecho"))
(setq old_osmode (getvar "OSMODE"))
(setq old_clayer (getvar "clayer"))
(setq old_ucsview (getvar "ucsview"))
(setq old_dimzin (getvar "dimzin"))
(setq old_EXPERT (getvar "EXPERT"))
(setq oldcol (getvar "CECOLOR"))
(setq old_error *error*)
(setvar "cmdecho" 0)
(setvar "UCSVIEW" 1)
(setvar "osmode" 32)
(setvar "EXPERT" 4)
(setvar "DIMZIN" 0)
(command "view" "s" "orig")
(defun *error* (msg)
(setvar "osmode" old_osmode)
(setvar "clayer" old_clayer)
(setvar "DIMZIN" old_DIMZIN)
(setvar "EXPERT" old_EXPERT)
(setvar "CECOLOR" oldcol)
(command "view" "s" "orig")
(if (tblsearch "view" "orig")
(progn
(command "view" "r" "orig")
(command "view" "d" "orig")
)
)
(setvar "ucsview" old_ucsview)
(setvar "cmdecho" old_cmdecho)
(if
(/= "function cancelled" msg)
(if
(= msg "quit / exit abort")
(princ)
(princ (strcat "\nerror: " msg))
)
(princ)
)
(setq *error* old_error)
(princ)
)
(if
(= 1 (logand 1 (getvar "undoctl")))
(progn
(command "._undo" "group")
(setq intors t)
)
(set intors nil)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(setq plan_ref (getreal "\nWhat Bench mark have Pl.ref: "))
(setq pct_0 (getpoint "\nSelect one point on the reference line: ")
yzero (cadr pct_0)
)
(princ "\n >>Select polyline>>")
(if (setq ss (ssget "+.:S:E" '((0 . "*POLY*"))))
(progn
(vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
(if (not (tblsearch "layer" "Defpoints"))
(command "._-layer" "_M" "Defpoints" "_S" "" "")
)
(setq acsp (vla-get-modelspace adoc))
(setq ent (ssname ss 0))
(setq obj (vlax-ename->vla-object ent))
(setq sp (vlax-curve-getstartpoint obj)
ep (vlax-curve-getendpoint obj)
xstart (car sp)
xend (car ep)
xdelta (- xend xstart)
)
(setq xdist 0 cnt -1)
(while (< xdist xdelta)
(setq cnt (1+ cnt)
p1 (list (+ xstart (* 20. cnt)) yzero 0)
p2 (list (car p1) (+ yzero 1000.0) 0)
)
(setq xline (vla-addxline acsp (vlax-3d-point p1) (vlax-3d-point p2)))
(vlax-put xline 'Layer "Defpoints")
(setq pt (vlax-invoke xline 'IntersectWith obj 0))
(setq Dy (/ (- (cadr pt) (cadr pct_0)) 10.0 ) )
(command "._-insert" (strcat (getvar "dwgprefix")"COTAL1.DWG") "_non" pt 0.01 0.01 0 (rtos (+ plan_ref Dy) 2 2))
(setq xdist (+ xdist 20))
)
(command "._-insert" (strcat (getvar "dwgprefix")"COTAL1.DWG") "_non" ep 0.01 0.01 0 (rtos (+ plan_ref Dy) 2 2))
(setq sset (ssget "X" (list (cons 0 "XLINE")(cons 8 "Defpoints")(cons 410 (getvar "CTAB")))))
(if sset (command "._erase" sset ""))
(vla-endundomark (vla-get-activedocument (vlax-get-acad-object)))
)
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(if
intors
(progn
(command ".undo" "_end")
(setq intors nil)
)
)
(setvar "osmode" old_osmode)
(setvar "clayer" old_clayer)
(setvar "ucsview" old_ucsview)
(setvar "EXPERT" old_EXPERT)
(setvar "CECOLOR" oldcol)
(setVAR "dimzin" old_dimzin)
(setvar "cmdecho" old_cmdecho)
(gc)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(princ)
)
~'J'~ 谢谢你的回复，
我尝试了你的代码，给了我一个错误，只在第一点绘制了xline。
错误是：
********************
命令：CS
Pl.ref:268有什么基准点
在参考线上选择一个点：
>>选择多段线>>
选择对象：
错误：AutoCAD。应用：未找到密钥
********************
我跟着代码走了，好像还好，不知道哪里出了问题。
页:
[1]
2