社区 › Auto Lisp › 缩放多段线等高线

Bill_Myron 发表于 2022-7-6 08:59:05

缩放多段线等高线

我有一个很好的要求。我需要从地面坐标到网格坐标缩放一些多段线等高线。使用比例Com，这是可行的，但Z值也会被缩放。问题是，我只想缩放X和Y，而不是Z。
 
到目前为止，唯一的方法是创建一个块，缩放它，然后分解。这需要很多时间，在我看来这是不必要的。
 
这就是我所想的lisp例程，它可以做我需要的事情。
 
选择多段线（等高线）
将多边形缩放到某个因子。
在缩放之前，将Z值重置为原始值。
 
我希望这有意义。哈哈。
 
有人愿意解决这个问题吗？

eldon 发表于 2022-7-6 09:05:17

 
如果单独缩放轮廓，则不会缩放Z值。
 
大多数人可能会在输入数据之前缩放坐标。

BlackBox 发表于 2022-7-6 09:07:41

查看vla scaleEntity函数。

Bill_Myron 发表于 2022-7-6 09:12:23

eldon-scale命令均匀缩放多段线。它将比例应用于所有3个轴。给我的数据只是等高线。因此，我只能使用所给予的。
 
Render man-感谢开始。这个lisp可以只在x和y方向上缩放而不在Z方向上缩放吗？

Organic 发表于 2022-7-6 09:13:48

 
在我看来，这样缩放轮廓不是一个好做法。
 
 
如果这可行，你只需要一次性完成，那么为什么不这样做呢？

BlackBox 发表于 2022-7-6 09:19:41

 
你在代码测试中得到了什么结果？

eldon 发表于 2022-7-6 09:23:25

 
仅当缩放到0,0左右时。如果围绕各自的端点缩放每个等高线多段线，则Z值不变。

marko_ribar 发表于 2022-7-6 09:24:07

(defun c:scpl ( / pt elev bpt entpl scf )
(setq pt (getpoint "\nPick base point in XY plane for scaling your pline : "))
(setq entpl (car (entsel "\nPick pline you want to scale")))
(setq elev (cdr (assoc 38 (entget entpl))))
(setq bpt (list (car pt) (cadr pt) elev))
(setq scf (getreal "\nInput scale factor with or without decimal precision : "))
(vl-cmdf "_.scale" entpl "" bpt scf)
(princ)
)

 
M、 R。

BlackBox 发表于 2022-7-6 09:28:33

 
我希望用户不要错过。。。

BlackBox 发表于 2022-7-6 09:34:27

对Marko的代码进行了轻微修改（希望您不介意）：
 

(defun c:SCPL() (c:ScalePlines))
(defun c:ScalePlines(/ *error* nomutt oldNomutt ss pt scale)
(princ "\rSCALE MULTIPLE POLYLINES ")
(vl-load-com)

(defun *error*(msg)
   (and oldNomutt (setvar 'nomutt oldNomutt))
   (if acDoc (vla-endundomark acDoc))
   (cond ((not msg))                                                   ; Normal exit
         ((member msg '("Function cancelled" "quit / exit abort")))    ; <esc> or (quit)
         ((princ (strcat "\n** Error: " msg " ** "))))               ; Fatal error, display it
   (princ))

(defun nomutt (arg)
   (cond (oldNomutt)
         ((setq oldNomutt (getvar 'nomutt))))
   (if arg
   (setvar 'nomutt 1)
   (setvar 'nomutt 0)))

(prompt "\nSelect multiple polylines to scale: ")
(if (and (nomutt T)
          (setq ss (ssget "_:L" '((0 . "LWPOLYLINE"))))
          (nomutt nil)
          (setq pt (getpoint "\nSpecify base point: "))
          (setq scale (getreal "\nEnter scale factor: ")))
   ((lambda (acDoc / elev)
      (vla-startundomark acDoc)
      (vlax-for x(setq ss (vla-get-activeselectionset acDoc))
      (setq elev (vla-get-elevation x))
      (vla-scaleentity x (vlax-3d-point pt) scale)
      (vla-put-elevation x elev))
      (vla-delete ss)
      (setvar 'nomutt oldNomutt)
      (vla-endundomark acDoc))
   (vla-get-activedocument (vlax-get-acad-object)))
   (cond (pt (prompt "\n** Scale factor required ** "))
         (ss (prompt "\n** Base point required ** "))
         ((prompt "\n** Nothing selected ** "))))
(princ))

查看完整版本: 缩放多段线等高线