需要帮助升级我的LISP
您好，这里有一个LISP例程，用于确定某个多边形（通常是多段线）的比例。程序是这样的，用户将单击多边形的最北端、最南端、最东端和最西端点，然后确定比例。有没有升级的方法，比如只需单击多段线，就可以确定比例？没有更多的极端点点击。以下是lisp例程：
(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)
)
提前感谢 寻找：
(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。 我想这就是你想要的。。。你的miff diff逻辑让我有点困惑。
(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)
)
页:
[1]