需要帮助升级我的LISP

Russello · 发表于 2022-7-5 15:54:45

您好，这里有一个LISP例程，用于确定某个多边形（通常是多段线）的比例。程序是这样的，用户将单击多边形的最北端、最南端、最东端和最西端点，然后确定比例。有没有升级的方法，比如只需单击多段线，就可以确定比例？没有更多的极端点点击。

以下是lisp例程：

copy

(defun c:gs ( / xn xs xw xe diff miff)
(defun roundup100 ( x )
   (if (equal 0.0 (rem x 100) 1e-
       (atoi (rtos x 2 0))
       (* 100 (fix (1+ (/ x 100.0))))
      )
 )
 (defun roundup1000 ( y )
   (if (equal 0.0 (rem y 1000) 1e-
       (atoi (rtos y 2 0))
       (* 1000 (fix (1+ (/ y 1000.0))))
)
 )
 (setq xn (getpoint "\nPick the point on the extreme north of the lot boundary:"))
 (setq xs (getpoint xn "\nPick the point on the extreme south of the lot boundary:"))
 (setq xe (getpoint "\
Pick the point on the extreme east of the lot boundary:"))
 (setq xw (getpoint "\
Pick the point on the extreme west of the lot boundary:" xe))
 (setq diff (/ (- (cadr xn) (cadr xs)) 0.3))
 (setq miff (/ (- (car xe) (car xw)) 0.3))
(if (< miff diff)
(progn
(if (<= diff 800)
(princ (strcat "\n\nPlotting Scale is 1: " (rtos (roundup100 diff) 2 0)))
)
(if (> diff 800)
(princ (strcat "\n\nPlotting Scale is 1: " (rtos (roundup1000 diff) 2 0)))
)
 )
 )
(if (> miff diff)
(progn
(if (<= miff 800)
(princ (strcat "\n\nPlotting Scale is 1: " (rtos (roundup100 miff) 2 0)))
)
(if (> miff 800)
(princ (strcat "\n\nPlotting Scale is 1: " (rtos (roundup1000 diff) 2 0)))
)
)
 )
(princ)
 )

提前感谢

marko_ribar · 发表于 2022-7-5 16:33:34

寻找：

copy


(vla-getboundingbox (vlax-ename->vla-object pline-ename) 'lowerleftpoint 'upperrightpoint)
(mapcar 'set '(lowerleftpoint upperrightpoint) (mapcar 'safearray-value (list lowerleftpoint upperrightpoint)))

从变量：通过（vla getboundingbox）方法定义的lowerleftpoint和upperrightpoint，您应该能够获得例程所需的极值点。。。因此，在正确实现后，只有拾取或选择多段线或任何其他主题实体才能得到所需的结果。。。

HTH。，M、 R。

ronjonp · 发表于 2022-7-5 16:36:34

我想这就是你想要的。。。你的miff diff逻辑让我有点困惑。

copy

(defun c:gs (/ roundupto d e ll ur)
 (defun roundupto (x n)
   (if        (equal 0.0 (rem x n) 1e-
     (atoi (rtos x 2 0))
     (* n (fix (1+ (/ x n))))
   )
 )
 (if (setq e (car (entsel "\nPick something: ")))
   (progn (vla-getboundingbox (vlax-ename->vla-object e) 'll 'ur)
   (mapcar 'set '(ll ur) (mapcar 'vlax-safearray->list (list ll ur)))
   (setq d (apply 'max (mapcar 'abs (list (apply '- ll) (apply '- ur)))))
   (alert (strcat "\n\nPlotting Scale is 1: "
                  (rtos        (roundupto d
                                   (if (<= (/ d 0.3) 800)
                                     100.
                                     1000.
                                   )
                        )
                        2
                        0
                  )
          )
   )
   )
 )
 (princ)
)

Russello · 发表于 2022-7-5 16:58:10

[编程交流] 需要帮助升级我的LISP

发表回复

精选推荐