从dr创建块的Lsp
再一次，我在lsp上寻求帮助，这可以帮助我减少CAD处理时间和错误。情况：
我必须放大或缩小客户提供的图纸中的“多段线”尺寸。这些多段线大多是“矩形”或“正方形”。
由于它们不是块形式，我必须手动将它们编辑到我想要的维度。这花了我很多时间，以前我甚至把它们放大到了错误的尺寸。
问题：
是否可以使用lsp脚本将相同尺寸的“矩形”或“正方形”转换为块形式？
如果不同的块可以分为不同的层就好了。（层的名称并不重要）
这个脚本是否太难构建？
我附上了这幅画的样本。（仅需转换3种类型）
如果有专家能就此问题向我提供建议，我将不胜感激。
谢谢您！：眨眼：
卡尔
实例拉链 试试看
SetNB-将选定实体转换为块
SetNB1-在单独的命名块中转换每个选定的基元
(defun c:setnb (/ ss adoc pt_lst center blk *error* bi bname bpat)
;;;Selected Entities To Named Block
(setq bpat "BLOCK-") ;_ <- Edit block name pattern here
(defun *error* (msg)
(vla-endundomark adoc)
(princ msg)
(princ)
) ;_ end of defun
(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-StartUndoMark
(if (not (vl-catch-all-error-p
(vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
) ;_ end of vl-catch-all-error-p
) ;_ end of not
(progn
(setq
ss (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
) ;_ end of mapcar
pt_lst (apply 'append
(mapcar
'(lambda (x / minp maxp)
(vla-getboundingbox x 'minp 'maxp)
(list (vlax-safearray->list minp)
(vlax-safearray->list maxp)
) ;_ end of append
) ;_ end of lambda
ss
) ;_ end of mapcar
) ;_ end of append
center (mapcar '(lambda (a b) (/ (+ a b) 2.))
(list (apply 'min (mapcar 'car pt_lst))
(apply 'min (mapcar 'cadr pt_lst))
(apply 'min (mapcar 'caddr pt_lst))
) ;_ end of list
(list (apply 'max (mapcar 'car pt_lst))
(apply 'max (mapcar 'cadr pt_lst))
(apply 'max (mapcar 'caddr pt_lst))
) ;_ end of list
) ;_ end of mapcar
bname
(progn
(setq bi 0)
(while (tblsearch "BLOCK" (setq bname (strcat bpat (itoa(setq bi(1+ bi)))))))
bname)
blk (vla-add (vla-get-blocks adoc)
(vlax-3d-point center)
bname
) ;_ end of vla-add
) ;_ end of setq
(vla-copyobjects
adoc
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
ss
) ;_ end of vlax-safearray-fill
) ;_ end of vlax-make-variant
blk
) ;_ end of vla-copyobjects
(vla-insertblock
(vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
(vlax-3d-point center)
(vla-get-name blk)
1.0
1.0
1.0
0.0
) ;_ end of vla-insertblock
(mapcar 'vla-erase ss)
) ;_ end of and
) ;_ end of if
(vla-endundomark adoc)
(princ)
) ;_ end of defun
(defun c:SETNB1 (/ ss adoc pt_lst center blk *error* lst bpat bname bi)
;;;Each primitive in a separate named block
;;;Каждый примитив в отдельный Имсенованный блок
(defun *error* (msg)
(vla-endundomark adoc)
(princ msg)
(princ)
) ;_ end of defun
(setq bpat "BLOCK-") ;_ <- Edit block name pattern here
(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-StartUndoMark
(if (not (vl-catch-all-error-p
(vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
) ;_ end of vl-catch-all-error-p
) ;_ end of not
(progn
(mapcar '(lambda(item)
(setq
ss (list item)
pt_lst (apply 'append
(mapcar
'(lambda (x / minp maxp)
(vla-getboundingbox x 'minp 'maxp)
(list (vlax-safearray->list minp)
(vlax-safearray->list maxp)
) ;_ end of append
) ;_ end of lambda
ss
) ;_ end of mapcar
) ;_ end of append
center (mapcar '(lambda (a b) (/ (+ a b) 2.))
(list (apply 'min (mapcar 'car pt_lst))
(apply 'min (mapcar 'cadr pt_lst))
(apply 'min (mapcar 'caddr pt_lst))
) ;_ end of list
(list (apply 'max (mapcar 'car pt_lst))
(apply 'max (mapcar 'cadr pt_lst))
(apply 'max (mapcar 'caddr pt_lst))
) ;_ end of list
) ;_ end of mapcar
bname
(progn
(setq bi 0)
(while (tblsearch "BLOCK" (setq bname (strcat bpat (itoa(setq bi(1+ bi)))))))
bname)
blk (vla-add (vla-get-blocks adoc)
(vlax-3d-point center)
bname
) ;_ end of vla-add
) ;_ end of setq
(vla-copyobjects
adoc
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
ss
) ;_ end of vlax-safearray-fill
) ;_ end of vlax-make-variant
blk
) ;_ end of vla-copyobjects
(vla-insertblock
(vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
(vlax-3d-point center)
(vla-get-name blk)
1.0
1.0
1.0
0.0
) ;_ end of vla-insertblock
)
(setq
lst (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
) ;_ end of mapcar
)
)
(mapcar 'vla-erase lst)
) ;_ end of and
) ;_ end of if
(vla-endundomark adoc)
(princ)
)
你好，VVA，
非常感谢您的LSP！
我可以再要一个功能吗？
“SetNB1”正是我想要的。
但是，是否可以将选定的基本体转换为相同的块名？
当然，我会确保选择的形状是相同的。
对不起，如果我解释得不好。
希望你能理解我所说的。
我很高兴收到你的回复。
谢谢
卡尔 另一种方法：在选定对象的中心（边界框）缩放选定对象
(defun c:sm (/ ERRCOUNT MAXPT MINPT MIPT MNPT MXPT
OBJSET PTLST XLST YLST old Flg)
(vl-load-com)
(if(not sm:scale)(setq sm:scale 1))
(initget 6)
(setq old sm:scale
sm:scale(getdist
(strcat"\nSpecify the scale factor <"(rtos sm:scale 2 2)">: "))
); end setq
(if(null sm:scale)(setq sm:scale old))
(setq errCount 0 ptLst 'nil Flg t); en setq
(while Flg
(princ "\n§§§ Select objects and press Enter or Esc to exit. §§§")
(if
(not(setq objSet(ssget "_I")))
(setq objSet(ssget))
); end if
(if objSet
(progn
(setq objSet
(mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp
(mapcar 'cadr(ssnamex objSet)))))
(foreach obj objSet
(vla-GetBoundingBox obj 'MinPt 'MaxPt)
(setq mnPt(vlax-safearray->list MinPt)
mxPt(vlax-safearray->list MaxPt)
miPt (polar mnPt (angle mnPt mxPt)(* 0.5 (distance mnPt mxPt)))
)
(if (vlax-method-applicable-p obj 'ScaleEntity)
(if
(vl-catch-all-error-p
(vl-catch-all-apply 'vla-ScaleEntity
(list obj(vlax-3D-Point miPt) sm:scale)))
(setq errCount(1+ errCount))
)
)
); end foreach
(princ(strcat "\n" (itoa errCount) " objects blocked layer! "))
)
); if objset
(setq Flg nil)
); end while
)
您必须确保所选形状相同
(defun c:SETNB2 (/ ss adoc pt_lst center blk *error* lst bpat bname bi first)
;;;Each primitive in a separate named block
;;;http://www.cadtutor.net/forum/showthread.php?p=287449&posted=1#post287449
(defun *error* (msg)
(vla-endundomark adoc)
(princ msg)
(princ)
) ;_ end of defun
(setq bpat "BLOCK-") ;_ <- Edit block name pattern here
(vl-load-com)
(vla-startundomark
(setq adoc (vla-get-activedocument (vlax-get-acad-object)))
) ;_ end of vla-StartUndoMark
(if (not (vl-catch-all-error-p
(vl-catch-all-apply '(lambda () (setq ss (ssget "_:L"))))
) ;_ end of vl-catch-all-error-p
) ;_ end of not
(progn
(mapcar '(lambda(item)
(setq
ss (list item)
pt_lst (apply 'append
(mapcar
'(lambda (x / minp maxp)
(vla-getboundingbox x 'minp 'maxp)
(list (vlax-safearray->list minp)
(vlax-safearray->list maxp)
) ;_ end of append
) ;_ end of lambda
ss
) ;_ end of mapcar
) ;_ end of append
center (mapcar '(lambda (a b) (/ (+ a b) 2.))
(list (apply 'min (mapcar 'car pt_lst))
(apply 'min (mapcar 'cadr pt_lst))
(apply 'min (mapcar 'caddr pt_lst))
) ;_ end of list
(list (apply 'max (mapcar 'car pt_lst))
(apply 'max (mapcar 'cadr pt_lst))
(apply 'max (mapcar 'caddr pt_lst))
) ;_ end of list
) ;_ end of mapcar
)
(if (null first)
(progn
(setq
bname
(progn
(setq bi 0)
(while (tblsearch "BLOCK" (setq bname (strcat bpat (itoa(setq bi(1+ bi)))))))
bname)
blk
(vla-add (vla-get-blocks adoc)
(vlax-3d-point center)
bname
)
) ;_ end of setq
(vla-copyobjects
adoc
(vlax-make-variant
(vlax-safearray-fill
(vlax-make-safearray vlax-vbobject (cons 0 (1- (length ss))))
ss
) ;_ end of vlax-safearray-fill
) ;_ end of vlax-make-variant
blk
);_ end of vla-copyobjects
(setq first t)
)
)
(vla-insertblock
(vla-objectidtoobject adoc (vla-get-ownerid (car ss)))
(vlax-3d-point center)
(vla-get-name blk)
1.0
1.0
1.0
0.0
) ;_ end of vla-insertblock
)
(setq
lst (mapcar 'vlax-ename->vla-object
(vl-remove-if 'listp (mapcar 'cadr (ssnamex ss)))
) ;_ end of mapcar
)
)
(mapcar 'vla-erase lst)
) ;_ end of and
) ;_ end of if
(vla-endundomark adoc)
(princ)
)
VVA，
我衷心感谢你。
你的好意深深打动了我的感激之情。
卡尔 只需添加，我将通过将块对齐为直线和多段线来实现，以下是我之前所做的：
；|******************************************************************创建用于将块恢复/对齐/替换为具有不同旋转的类似直线/多段线的程序日期：2008年11月20日创建人：RONALD MANEJA（WIZMAN）。。。email\u add:罗恩_09812001@yahoo.com----也可用于修改块的插入点***********************；（defun c:blocker（/blkname blocker\u kword bloker\u newset blok\u rot\u strng counter fpoint ronblock ronblockdata seta spoint*error*）；；；；------------------------------------------------------------------------------------------；；；初始化setvar、rtd、dtr和*error*函数（setvar的cmdecho 0）（vl load com）（defun rtd（a）（/（*a 180）pi））；_end_defun（defun DTR（a）（*PI（/a 180.0））；_end_defun（defun*error*（msg）（vla EndUndoMark（vla Get ActiveDocument（vlax Get Acad Object））；_end_vla-Get-ActiveDocument）；_end_vla-EndUndoMark（setvar'cmdecho 1））；_end_defun；；；--------------------------------------------------------------------------------；；；blok\u rot函数-相对旋转选择中的对象（defun blok\u rot（blok\u set/blok\u rot\u allset blok\u rot\u计数器）（setq blok\u rot\u allset blok\u set）（while（not）（成员（strcase）（setq blok\u rot\u strng（getstring“\n>>…按空格键/回车键继续旋转，移动或退出…>>：”）；\uend_getint）；_end_setq）；_end_strcase’（“M”“E”）；_end_成员）；_end\u not（setq blok\u rot\u counter 0）（while（<blok\u rot\u counter（sslength blok\u rot\u allset））（命令“rotate”（ssname blok\u rot\u allset blok\u rot\u counter）”（cdr（assoc 10（entget（ssname blok\u rot\u allset blok\u rot\u counter））；\uend_assoc）；_end_cdr 90）；_end_命令（setq blok_rot_计数器（1+blok_rot_计数器））；_end_while）；_end_while（if（=（strcase blok\u rot\u strng）“M”）（bmov bloker\u newset））；_end\u if（if（=（strcase blok\u rot\u strng）“E”）（progn（initget 1“Yes No”）（setq blok\u del\u kword（getkword“\n>>>…是否要删除参考线[是/否]？…>>：”）；\uend_getkword）；_end\u setq（if（=blok\u del\u kword“Yes”）（progn（vl cmdf）.\u erase“seta”）（*error*nil）（exit））；\uend_progn（progn（*error*nil）（exit））；_end_progn）；_end_if）；_end_progn）；_end_if）；_end_defun；；；--------------------------------------------------------------------------------；；；bmov函数-相对移动选择中的对象（defun bmov（bmov\u集/2nd\u pt\u bmov allset\u bmov ang\u bmov counter\u bmov dist\u bmov ent\u rot\u bmov）（setq allset\u bmov bmov\u集）（while（and（not（initget 129））（setq dist\u bmov（getdist“\n>>…输入移动距离，旋转或退出…>>：”；\uend_getdist）；_end_setq；（成员（strcase dist\u bmov）“（R”“E”）；_end\u和（cond（（=（numberp dist\u bmov）T）（progn（而（progn（setq ang\u bmov（cond）（（getint“\n输入相对方向））；\uend_getint）（0））；_end_cond）；_end_setq（if（not（成员ang_bmov’（0 90 180 270-90））；_end\u not（not（提示“\n错误角度必须为0 90 180 270，请重新输入”）；\uend_提示符）；_end_not）；_end_if）；_end_progn）；_end\u while（setq counter\u bmov 0）（while（<counter\u bmov（sslength allset\u bmov））（setq ent\u rot\u bmov（cdr（assoc 50（entget（ssname allset\u bmov counter\u bmov）））；\uend_cdr）；_end\u setq（setq 2nd\u pt\u bmov（polar（cdr（assoc 10（entget（ssname allset\u bmov counter\u bmov））））（+ent\u rot\u bmov（dtr ang\u bmov））dist\u bmov）；\uend_polar）；_end_setq（命令“move”（ssname allset\u bmov counter\u bmov）“”“_non”（cdr（assoc 10（entget（ssname allset\u bmov counter\u bmov）））“_non”2nd\u pt\u bmov）；_end_命令（setq counter_bmov（1+counter_bmov））end_while）；_end\u progn）（（=（strcase dist\u bmov）“R”）（blok\u rot bloker\u newset））（（=（strcase dist\u bmov）“E”）（progn（initget 1“Yes No”）（setq blok\u del\u kword（getkword“\n>>…是否要删除参考线[是/否]？…>>：”；\uend_getkword）；_end\u setq（if（=blok\u del\u kword“Yes”）（progn（vl cmdf）.\u erase“seta”）（*error*nil）（exit））；\uend_progn（progn（*error*nil）（exit））；_end_progn）；_end_if）；_end_progn））；_end_cond）；_end_while）；_end_defun；；；--------------------------------------------------------------------------------；；；结束撤消，开始撤消（vla EndUndoMark（vla Get ActiveDocument（vlax Get Acad Object））；_end_vla-Get-ActiveDocument）；_end_vla-EndUndoMark（vla StartUndoMark（vla Get ActiveDocument（vlax Get Acad Object））；_end_vla-Get-ActiveDocument）；_end_vla-StartUndoMark；；；-----------------------------------------------------------------；；；主例程（while（not（and）（或（setq ronblock（car（entsel“\n>>>…选择一个块…>>”））））（提示“\n missed，重试。”）；\uend\u或（或（=（cdr（assoc 0（entget ronblock）））“INSERT”）（提示“\n>>…这不是块，这次选择块……选择要对齐的线或多段线…>>>”；\uend\u提示符（setq seta（ssget’（（0。“LWpolyline，line”）））（setq计数器0）（setq bloker\u newset（ssadd））（mapcar’（lambda（x）（setq fpoint（vlax curve getPointAtParam x 0））（setq spoint（vlax curve getPointAtParam x 1））（entmake（list（cons 0“INSERT”）（cons 2 blkname）（10 fpoint）（cons 41 1）（cons 42 1）（cons 43 1）（cons 50（角度fpoint spoint））；_end_列表）；_end\u entmake（ssadd（entlast）bloker\u newset）；（vla删除x））；_end_lambda（mapcar“vlax ename->vla object（vl remove if”listp（mapcar”cadr（ssnamex seta））；_vl结束删除if）；_end_mapcar）；_end\u mapcar（princ（strcat“\n添加到图形的块的数量=（vl princ to string（sslength bloker\u newset））；\uend_strcat）；_end\u princ（initget 7“Move Rotate Exit”）（if（setq blocker\u kword（getkword“\n是否要[旋转/移动/退出]？：”））（progn（if（null blocker\u kword）（setq blocker\u kword“退出”）；\uend\u if（cond（（=blocker\u kword“Move”）（（bmov bloker\u newset））（=blocker\u kword“Rotate”）（（blok\u rot bloker\u newset））（（=blocker\u kword“Exit”）（progn（initget 1“Yes No”）（setq blok\u del\u kword（getkword“\n>>>…是否要删除参考线[是/否]？…>>：”；\uend\u ge公司 Is it possible with SETNB2.lsp to keep the hyperlink attached.
Jaap
页:
[1]