求解(ssget)与（entsel）
本帖最后由 suiran 于 2024-4-27 18:06 编辑以下是对图形进行X、Y方向比例缩放的程序，但是这个程序是对多个图形缩放，我想改为只能对一个图形缩放，就是点选(entsel)的方式，奈何学艺不精，改了一晚上都没有成功，求坛友们指点迷津！
[*](defun C:SF(/ bp ss xscal yscal entL)
[*]
[*] (defun errexit (s)
[*] (princ "\nError:")
[*] (princ s)
[*] (restore)
[*] )
[*]
[*] (defun restore ()
[*] (setvar "CMDECHO" (car oldvar))
[*] (setq *error* olderr)
[*] (princ)
[*] )
[*]
[*] (defun MAKEUNBLOCK (ss ip / tmp errexit mbx BLAYER)
[*]
[*] (setq T (not nil))
[*] (setq olderr*error*
[*] *error* errexit
[*] )
[*] (setq oldvar
[*] (list
[*] (getvar "CMDECHO")
[*] )
[*] )
[*] (setvar "CMDECHO" 0)
[*] (terpri)
[*] (if BLAYER
[*] (command "._LAYER"
[*] (if (tblsearch "LAYER" BLAYER) "_S" "_M")
[*] BLAYER
[*] ""
[*] )
[*] )
[*] (if (and ip ss)
[*] (progn
[*] (entmake (list
[*] (cons '0 "BLOCK")
[*] (cons '2 "*U")
[*] (cons '70 1)
[*] (cons '10 ip)
[*] ))
[*] (setq cnt (sslength ss))
[*] (while (>= (setq cnt (1- cnt)) 0)
[*] (setq tmp (ssname ss cnt))
[*] (entmake (setq el (entget tmp)))
[*] (if (> (cdr (assoc 66 el)) 0)
[*] (while
[*] (/= "SEQEND"
[*] (cdr
[*] (assoc 0
[*] (entmake (setq el (entget (entnext (cdr (assoc -1 el))))))
[*] )
[*] )
[*] )
[*] )
[*] )
[*] (entdel tmp)
[*] )
[*] (setq tmp (entmake (list (cons '0 "ENDBLK"))))
[*] (entmake (list
[*] (cons '0 "INSERT")
[*] (cons '2 tmp)
[*] (cons '10 ip)
[*] ))
[*] )
[*] )
[*] (restore)
[*] )
[*]
[*] (setq ss (ssget)) ;;; 选择缩放实体
[*](if ss
[*] (progn
[*] (setvar "cmdecho" 0)
[*] (setq bp (getpoint "缩放基准点 (<0,0,0>): "))
[*] (if (not bp) (setq bp (list 0 0 0)))
[*] (setq xscal (getreal "X向比例因子 <1>: "))
[*] (if (not xscal) (setq xscal 1))
[*] (setq yscal (getreal "Y向比例因子 <1>: "))
[*] (if (not yscal) (setq yscal 1))
[*] (MAKEUNBLOCK ss bp)
[*] (setq entL (entget (entLast))
[*] entL (subst (cons 41 xscal) (assoc 41 entL) entL)
[*] entL (subst (cons 42 yscal) (assoc 42 entL) entL)
[*] )
[*] (entmod entL)
[*] (command "_explode" "l" "")
[*] )
[*] )
[*] (princ)
[*] )
粘贴带有行号的代码，一般人不愿意帮你调试，vlide界面的代码是没有行号的 dcl1214 发表于 2024-4-27 17:53
粘贴带有行号的代码，一般人不愿意帮你调试，vlide界面的代码是没有行号的
那我传个lsp文件吧。别的也不会 (defun C:SF(/ bp entl makeunblock ty xscal yscal)
(defun MAKEUNBLOCK (ty ip / tmp errexit mbx BLAYER)
(setvar "CMDECHO" 0)
(if (and ip ty)
(progn
(entmake (list
(cons '0 "BLOCK")
(cons '2 "*U")
(cons '70 1)
(cons '10 ip)
)
)
(entmake (setq el (entget ty)))
(if (> (cdr (assoc 66 el)) 0)
(while
(/= "SEQEND"
(cdr
(assoc 0
(entmake (setq el (entget (entnext (cdr (assoc -1 el))))))
)
)
)
)
)
(entdel ty)
(setq tmp (entmake (list (cons '0 "ENDBLK"))))
(entmake (list
(cons '0 "INSERT")
(cons '2 tmp)
(cons '10 ip)
))
)
)
)
(if (setq ty (car(entsel "\n选择缩放图元:")))
(progn
(setvar "cmdecho" 0)
(setq bp (getpoint "缩放基准点 (<0,0,0>): "))
(if (not bp) (setq bp (list 0 0 0)))
(setq xscal (getreal "X向比例因子 <1>: "))
(if (not xscal) (setq xscal 1))
(setq yscal (getreal "Y向比例因子 <1>: "))
(if (not yscal) (setq yscal 1))
(MAKEUNBLOCK ty bp)
(setq
entL (entget (entLast))
entL (subst (cons 41 xscal) (assoc 41 entL) entL)
entL (subst (cons 42 yscal) (assoc 42 entL) entL)
)
(entmod entL)
(command "_explode" "l" "")
)
)
(princ)
) 飞雪神光 发表于 2024-4-27 19:34
热心大神 飞雪神光 发表于 2024-4-27 19:34
感谢大神的再次帮助！已经帮了我好几次了
我好好研究一下，感谢。
设选择实体为多段线，提取多段线坐标，以起点为基点，把起点坐标调整为（0 0）坐标，则多段线坐标转换为（list（list 0 0）（list 1 1）（list 1 2))，Y方向放大2倍，下一步就得到（list（list0 0）（list1 2）（list1 4)) ，其实就已经完成了坐标计算的搭建。接下来就需要把坐标返回，或者给定标注坐标，生成新的多段线。 JUN1 发表于 2024-4-28 08:34
设选择实体为多段线，提取多段线坐标，以起点为基点，把起点坐标调整为（0 0）坐标，则多段线坐标转换为（l ...
感谢兄台细心的答复。:handshake
页:
[1]