lisp例程帮助，添加bl

bogdancic26 · 发表于 2022-7-6 10:54:55

大家好，

我想把块放在多段线上，因为模型是从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-invoke  Xline '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 (+ Dx  20.0 ))
(setq startpt secondpt)
 )
 (gc)
 
(princ)
 )

COTAL1.DWG
lg-mc22_00。图纸
Cote\U scurgere\U ape v1.2-eng.LSP

ReMark · 发表于 2022-7-6 11:03:25

为什么不使用Measure或Divide命令来做同样的事情？两者都可以利用块。我不认为有任何禁止使用属性块。

bogdancic26 · 发表于 2022-7-6 11:06:31

我想添加块，但要插入的距离（20m）必须在x方向上水平测量，与多段线的斜率无关。
每个块的属性表示纵向纵断面中的高程点。
Measure或Divide命令使用两个插入块之间的段长度，但对我来说这是未知的（是可变的）。
常数为水平距离20m。

ReMark · 发表于 2022-7-6 11:11:20

你是说这些方块的间距不同？

bogdancic26 · 发表于 2022-7-6 11:15:38

是的，如果看一下我的示例“lg-mc22_00.dwg”，你会看到我想要如何绘制块。

bogdancic26 · 发表于 2022-7-6 11:23:21

大家好，

我有一个旧的例程，这就是我想要的，但把块放在多段线的每个顶点。
你们可以告诉我怎样改变，把块只放在从20m到20m的顶点上，正如你们在第二个例子中看到的那个样？

bogdancic26 · 发表于 2022-7-6 11:28:14

我忘了输入代码。

copy

(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

bogdancic26 · 发表于 2022-7-6 11:30:11

这里没有人能帮我吗？

fixo · 发表于 2022-7-6 11:35:21

问题在于您沿多段线按距离计算点
但是你需要沿着X轴计算它们
这是一个快速而肮脏的代码（没有数学）

copy


(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'~

bogdancic26 · 发表于 2022-7-6 11:43:24

谢谢你的回复，

我尝试了你的代码，给了我一个错误，只在第一点绘制了xline。
错误是：

********************

命令：CS
Pl.ref:268有什么基准点
在参考线上选择一个点：
>>选择多段线>>
选择对象：
错误：AutoCAD。应用：未找到密钥

********************

我跟着代码走了，好像还好，不知道哪里出了问题。

[编程交流] lisp例程帮助，添加bl

发表回复

精选推荐