插入块的最佳方式
你好插入搜索路径中已存在属性的块的最佳方法是什么
具有拾取旋转的选项
我用这个，但不能把波克层
(command "insert" "blkname.dwg" "non" n scxscy (- 300(/(*( GETanglep0 )200)PI))("attribu")) 您可以使用vla插入一个块，但如果您想坚持使用该代码位，您可以始终在该行之后添加该代码以更改层：
(vla-put-layer (vlax-ename->vla-object (entlast)) "YOUR LAYER NAME HERE") 谢谢commandobill，好的，但是有没有其他方法插入带有属性的块 这是一个很好的例子。 李在这里也有一些很好的添加属性的方法。 commandobill这种方式不成功，我认为是因为最后一个实体不是属性块，我得到一条消息{；错误：自动化错误。找不到键}
这是我的旧lisp，用来获取纵断面中任意点的高程
(defun c:ff ()
(setq angbs(getvar"angbase"))
(setq aunts(getvar"aunits"))
(setq insunt(getvar"insunits"))
(if(null txth)
(setq txth 1.25))
(setq txthnew(getreal(strcat"\n enter text height<sc:1/1000-txth=2.5;sc:1/500-txth=1.25;sc:1/200-txth=0.5>:"
"<" (rtos txth 2 2)">:")))
(if txthnew(setq txth txthnew))
(if(null scrt)
(setq scrt 1))
(setq scrtnew(getreal(strcat"\n enter scale ratio(vertical/horizental)"
"<" (rtos scrt 2 2)">:")))
(if scrtnew(setq scrt scrtnew))
(if(null dh)
(setq dh 0))
(setq dhnew (getreal(strcat"\n enter datum level:""<"(rtos dh 2 0)">:")))
(if dhnew(setq dh dhnew))
(initget 1)
(setq p0 (getpoint "\pick any point on datum line"))
(while
(setvar"blipmode"0)
(initget 1)
(setq n (getpoint "\n pick point to get elevation"))
;;;;;;;;;;;;;;;;;;;;;;;;
(setvar "angbase"(/ pi 2))
(setvar "aunits"2)
(setvar"insunits"6)
;;;;;;;;;;;;;;;;;;;;;;;
(command "insert" "lvm.dwg" "non" n txthtxth (- 300(/(*( getanglen )200)PI))(rtos (+ dh (/(-(cadr n)(cadr p0)) scrt)) 2 3))
;(vla-put-layer (vlax-ename->vla-object (entlast)) "mark-level")
(setvar"aunits"aunts)
(setvar"angbase"angbs)
(setvar"insunits"insunt)
)
)
并附上方块
lvm。图纸 可能一个简单的do层首先期望层存在，这是库函数在其中爬行的地方，因为do层存在，然后可能是类似alanjt例程的东西。
(command "-layer" "S" "yourlayername" "" "insert" "blkname.dwg" "non" n scxscy (- 300(/(*( GETanglep0 )200)PI))("attribu"))
你好
试试这个[未经测试的]程序，让我知道。
注意：添加所需的图层名称，如程序中红色所示，并带有图形的完整路径。
(defun c:ff (/ *error* vals dhnew n p scrtnew txthnew ang ent e lay)
(defun *error* (x)
(if vals
(mapcar 'setvar '(angbase aunits insunits blipmode) vals)
)
(and x
(not (wcmatch (strcase x) "*BREAK*,*CANCEL*,*EXIT*"))
(princ (strcat "\n ** Error : " x " **"))
)
)
(setq vals (mapcar 'getvar '(angbase aunits insunits blipmode)))
(if (not txth)
(setq txth 1.25)
)
(if (not scrt)
(setq scrt 1)
)
(if (not dh)
(setq dh 0)
)
(if (and (setq filename (findfile "lvm.dwg")) ;; Add the full of the drawing
(tblsearch "LAYER" (setq lay "0")) ;; Replace the "0" layer name with your desired layer name.
(progn
(initget 6)
(cond ((setq txthnew
(getreal
(strcat
"\n enter text height<sc:1/1000-txth=2.5;sc:1/500-txth=1.25;sc:1/200-txth=0.5>: <"
(rtos txth 2 2)
" >:"
)
)
)
(setq txth txthnew)
)
(t (setq txthnew txth))
)
)
(progn
(initget 6)
(cond ((setq scrtnew
(getreal
(strcat
"\nEnter scale ratio < "
(rtos scrt 2 2)
" >:"
)
)
)
(setq scrt scrtnew)
)
(t (setq scrtnew scrt))
)
)
(progn
(initget 6)
(cond ((setq dhnew (getreal (strcat "\n enter datum level < "
(rtos dh 2 0)
" > :"
)
)
)
(setq dh dhnew)
)
(t (setq dhnew dh))
)
)
(progn
(initget 1)
(setq p (getpoint "\pick any point on datum line"))
)
)
(progn
(mapcar 'setvar
'(angbase aunits insunits blipmode)
(list (/ pi 2) 2 6 0)
)
(while (progn
(initget 1)
(setq n (getpoint "\nPick point to get elevation"))
(setq ang (getangle n "\nSpecify Rotation angle :"))
(setq ent (entlast))
)
(command "_.-insert"
filename
"non"
n
txth
txth
(- 300 (/ (* ang 200) pi))
(rtos (+ dh (/ (- (cadr n) (cadr p)) scrt)) 2 3)
)
(if (not (eq ent (setq e (entlast))))
(entmod (append (entget e) (list (cons 8 lay))))
)
)
)
)
(*error* nil)
(princ)
)
谢谢你做得很好，我会修改我所有的旧lisp以同样的方式工作
不客气，只要问一下你是否需要任何澄清或添加到程序中即可
页:
[1]