块溶解对象#039；s
你好我有一个lisp，可以分解一个块，然后我可以编辑它。
我会把它扔到一个街区。
通过向下滑动block lisp制动器。
(defun c:eb ( / wucs)
(setq wucs (getvar "WORLDUCS")) ; if it is not at WORLD UCS
(if (= wucs 0)
(command "_UCS" "W") ; set it to WORLD
); end if
(if G_blname ; if this variable exists
(redefinebl) ; redfine the previously edited block
(editbl) ; otherwise edit a block
); end if
(if (= wucs 0) ; if it was not at WORLD UCS
(command "_UCS" "v") ; set it to the previous UCS
); end if
(princ)
)
; error trapping - clears toggle variable on error or cancel
; the only trouble is that the "undo" command does not clear the toggle as well!
(defun traperr (s)
(if (or (/= s "Function cancelled")(= s "quit / exit abort") )
(progn
(if G_blname
(progn
(setq G_blname nil)
); end progn
); end if
(setq G_pt nil)
(princ)
); end progn
(princ (strcat "\nError: " s))
)
) ;end traperr
(defun editbl (/ ent entl pt pt1 b)
(setq temperr *error*)
(setq *error* traperr)
(setq ent nil) ; initialise
(while (= ent nil) ; loop till a block is chosen
(while (= ent nil) ; loop to stop user clicking off the target entity and causing an error
(setq ent (entsel "\nWählen Sie einen Block zum Bearbeiten")) ; Sets ent to the selected entity
(if (= ent nil) (prompt "\nKein Objekt gewählt, versuchen Sie es nochmals."))
); end while
(setq entl (entget (car ent))) ; Sets entl to the selected entity's association list of the chosen
entity
(setq b (cdr (assoc 0 entl))) ; finds the entity type
(setq pt1 (cdr (assoc 10 entl))) ; finds the insertion point
(if (/= b "INSERT")
(progn
(setq ent nil) ; re-set if not a block to loop again
(prompt "\nDas ist kein Block.")
); end progn
)
); end while
(setq G_blname (cdr (assoc 2 entl))) ; finds the block name & puts it in a global variable
(setq pt (GETPOINT pt1 "\nCopy des Blocks für Bearbeitung: "))
(command "_INSERT" G_blname pt 1.0 0.0 0.0) ; inserts the block again for redefining
(setq ent (entlast)) ; Sets en to the name of the last entity in the drawing
(setq entl (entget ent)) ; Sets ed to the entity data of entity ent
(setq G_pt (cdr (assoc 10 entl))) ; finds the insertion point & puts it in a global variable
(command "_EXPLODE" "_L" "") ; explodes this last entity
(alert (strcat"\nDiese Copy vom \"" G_blname "\" würde Aufgelöst.\nRe-type: <EB> eingeben um den Block neu zu definieren nach Bearbeiten"))
;;(command "_scale")
(setq *error* temperr)
(princ)
); program ends
(defun redefinebl ()
(setq temperr *error*)
(setq *error* traperr)
(command "_-Block" G_blname "_y" G_pt) ; the "Y" is because the commands asks if you want to re-define the block
(setq G_blname nil) ; set to nil as this is used as a redefine/edit toggle
(setq G_pt nil) ; set to nil to free up memory
(setq *error* temperr)
)
你能帮助我吗？ 我不理解这里是否需要Lisp程序
您能否在autocad中仅缩放块？
我将在不改变因子1的情况下缩放块
例如，当我在autocad中缩放块时，我取10，那么系数也是10，但我想要1
（因为我必须更改400个块的大小，但系数应为1） 400块在同一张图中吗？ 我不确定你到底在寻找什么，但这是朝着正确方向迈出的一步。
它尽可能简单，并且可以轻松修改。
(defun c:blsc (/ ss sslnt cnt nentlst entn ent blnam inpt plst)
(setq ss (ssget "_x" '((0 . "insert")(410 . "Model") )))
(setq sslnt (sslength ss))
(setq cnt 0)
(while (< cnt sslnt)
(setq entn (ssname ss cnt));_entity name
(setq ent(entget entn));_entity list
(setq blnam (cdr(assoc 2 ent)));_block name
(setq inpt (cdr (assoc 10 ent)));_insert pt
(command "scale" entn "" inpt 10);_scale block
(setq plst (gtbox entn));_call to get bounging bos points
(command "explode" entn);_explode block
(setq nentlst (ssget "_W" (nth 0 plst)(nth 1 plst)));_all entities in the block
(command "-block" blnam "Y" inpt nentlst "");_remake block
(command "insert" blnam inpt "" "" "")
(setq cnt (1+ cnt))
);_while
);_defun
(defun gtbox (aug1 / rect llc urc )
(vla-GetBoundingBox (vlax-ename->vla-object aug1) 'minpt 'maxpt);_check for heigth /width
(setq
llc (vlax-safearray->list minpt)
urc (vlax-safearray->list maxpt)
);_setq
(setq trlst (list urc llc));_return upper right and lower left corners
);_defun
你好，约翰·M
比例x=1
比例y=1
1、方块分解
2、比例尺10
3、再次阻断
比例x=1
Scaley=1
（定义c:blsc（/ss sslnt cnt ENTLST entn ent blnam inpt plst）
（setq ss（ssget））
（setq sslnt（sslength ss））
（setq cnt 0）
（虽然(
（setq entn（ssname ss cnt））_实体名称
（setq ent（entget entn））_实体列表
（setq blnam（cdr（assoc 2 ent））_块名称
（setq输入（cdr（assoc 10 ent））_插入pt
（命令“_explode”entn）_分解块
（setq NTELST（ssget“_W”（第n个0 plst）（第n个1 plst））_块中的所有实体
（setq plst（gtbox entn））_致电获取bounging bos积分
（命令“_scale”entn“”输入10）_刻度块
（命令“_block”blnam“Y”inpt nentlst”“）_重做区块
（命令“_insert”blnam inpt“”“”）
（setq cnt（1+cnt））
);_虽然
);_德芬
（defun gtbox（aug1/rect llc urc）
（vla GetBoundingBox（vlax ename->vla object aug1）‘minpt’maxpt）_检查高度/宽度
（setq）
llc（vlax safearray->list minpt）
urc（vlax safearray->list maxpt）
);_setq公司
（setq trlst（list urc llc））_返回右上角和左下角
);_德芬
丹克 您对gtbox的调用应该在（setq nentlst）之上，因为它返回setq nentlst使用的点
哈罗·约翰姆
不会退出
以下错误消息
之前：；Fehler:FehlerAfter Argumenttyp:VLA-OBJECT nil
（定义c:blsc（/ss sslnt cnt ENTLST entn ent blnam inpt plst）
（vl load com）
（setq ss（ssget））
（setq sslnt（sslength ss））
（setq cnt 0）
（同时（<cnt sslnt）
（setq entn（ssname ss cnt））_实体名称
（setq ent（entget entn））_实体列表
（setq blnam（cdr（assoc 2 ent））_块名称
（setq输入（cdr（assoc 10 ent））_插入pt
（setq plst（gtbox entn））_致电获取bounging bos积分
（命令“_explode”entn）_分解块
（setq NTELST（ssget“_W”（第n个0 plst）（第n个1 plst））_块中的所有实体
（命令“NU scale”nentlst“”inpt 10）_刻度块
（命令“_block”blnam“Y”inpt nentlst”“）_重做区块
（命令“_insert”blnam inpt“”“”）
（setq cnt（1+cnt））
);_虽然
);_德芬
（defun gtbox（aug1/rect llc urc）
（vla GetBoundingBox（vlax ename->vla object aug1）‘minpt’maxpt）_检查高度/宽度
（setq）
llc（vlax safearray->list minpt）
urc（vlax safearray->list maxpt）
);_setq公司
（setq trlst（list urc llc））_返回右上角和左下角
);_德芬
谢谢谢谢 哈罗·约翰姆
是吗
（定义c:blsc（/ss sslnt cnt ENTLST entn ent blnam inpt plst）
（vl load com）
（setq ss（ssget））
（setq sslnt（sslength ss））
（setq cnt 0）
（虽然(
（setq entn（ssname ss cnt））_实体名称
（setq ent（entget entn））_实体列表
（setq blnam（cdr（assoc 2 ent））_块名称
（setq plst（gtbox entn））_致电获取bounging bos积分
（setq输入（cdr（assoc 10 ent））_插入pt
（命令“_explode”entn）_分解块
（setq NTELST（ssget“_W”（第n个0 plst）（第n个1 plst））_块中的所有实体
（命令“NU scale”nentlst“”inpt 2）_刻度块
（命令“_block”blnam“j”inpt NTELST”“）_重做区块
（命令“_insert”blnam inpt“”“”）
（setq cnt（1+cnt））
);_虽然
);_德芬
（defun gtbox（aug1/rect llc urc）
（vla GetBoundingBox（vlax ename->vla object aug1）‘minpt’maxpt）_检查高度/宽度
（setq）
llc（vlax safearray->list minpt）
urc（vlax safearray->list maxpt）
);_setq公司
（setq trlst（list urc llc））_返回右上角和左下角
);_德芬
1000 x谢谢 这在我的机器上很好用
我忘了在GTBOX DEFUN中杀死VARAIBLE trlst
你的这个，让我知道
(defun c:blsc (/ ss sslnt cnt nentlst entn ent blnam inpt plst)
(vl-load-com)
(setq ss (ssget))
(setq sslnt (sslength ss))
(setq cnt 0)
(while (< cnt sslnt)
(setq entn (ssname ss cnt));_entity name
(setq ent(entget entn));_entity list
(setq blnam (cdr(assoc 2 ent)));_block name
(setq inpt (cdr (assoc 10 ent)));_insert pt
(setq plst (gtbox entn));_call to get bounging bos points
(command "_explode" entn);_explode block
(setq nentlst (ssget "_W" (nth 0 plst)(nth 1 plst)));_all entities in the block
(command "_scale" nentlst "" inpt 10);_scale block
(command "_block" blnam "Y" inpt nentlst "");_remake block
(command "_insert" blnam inpt "" "" "")
(setq cnt (1+ cnt))
);_while
);_defun
(defun gtbox (aug1 / rect llc urc trlst )
(vla-GetBoundingBox (vlax-ename->vla-object aug1) 'minpt 'maxpt);_check for heigth /width
(setq
llc (vlax-safearray->list minpt)
urc (vlax-safearray->list maxpt)
);_setq
(setq trlst (list urc llc));_return upper right and lower left corners
);_defun
页:
[1]