Lisp无法正常工作
有人能帮我解决这个Lisp程序的问题吗。我前阵子买的，从第一天开始就没用过，但我学会了如何处理它。它应该做什么：选择一组对象。围绕最大范围创建边界框，并将其偏移2“
它正在做什么：它创建了一个形状奇怪的边界框，没有正方形的角。
如何通过：如果启动命令，选择所有需要的对象，然后放大并按enter键。缩小并正确绘制边界框。只有当你放大很多的时候，它才会起作用。
(defun c:f6 (/ ll ur lr ul vlst ss clyr)
;;do a polar offset of the corners
;;ofs is a real of the offset value
;;returns a new point list
(defun offsetpts (ll lr ur ul ofs / ang)
(setq ang (angle ll lr)) ; base angle
(setq ll (polar ll (- ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))
lr (polar lr (- ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))
ur (polar ur (+ ang (/ pi 4)) (sqrt (* (* ofs ofs) 2)))
ul (polar ul (+ ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2)))
)
(if ll
(list ll lr ur ul)
)
) ; end defun
;;CAB 10/17/2006
;;returns a point list ((lower left)(upper right))
(defun ssboundingbox (ss / i ent lst ptlst mnpt mxpt)
(setq i -1)
(while (setq ent (ssname ss (setq i (1+ i))))
(setq lst (cons (vlax-ename->vla-object ent) lst))
)
(mapcar '(lambda (x)
(vla-getboundingbox x 'mnpt 'mxpt)
(setq ptlst (cons (vlax-safearray->list mnpt) ptlst))
(setq ptlst (cons (vlax-safearray->list mxpt) ptlst))
)
lst
)
;;following by Tony Tanzillo
(list
(apply 'mapcar (cons 'min ptlst))
(apply 'mapcar (cons 'max ptlst))
)
)
;;=====================================================
(setq clyr (getvar "clayer"))
(prompt "\nSelect objects to frame.")
(if (setq ss (ssget))
(progn
(setq llur (ssboundingbox ss))
(setq LL (car llur)
UR (cadr llur)
LR (list (car UR) (cadr LL))
UL (list (car LL) (cadr UR))
)
(setq vlst (offsetpts LL LR UR UL 2.0))
(command "-layer" "m" "Face 6" "c" "red" "" "lt" "Dashed" "Face 6" "")
(command "_.pline")
(mapcar 'command vlst)
(command "_c")
)
)
(setvar "clayer" clyr)
loop
(princ)
) 如果UCS不是世界级的，那么它就不能很好地工作
所以
(defun trns (pt) (trans pt 0 1))
(setq ll (trns (polar ll (- ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2))))
lr (trns (polar lr (- ang (/ pi 4)) (sqrt (* (* ofs ofs) 2))))
ur (trns (polar ur (+ ang (/ pi 4)) (sqrt (* (* ofs ofs) 2))))
ul (trns (polar ul (+ ang (* pi 0.75)) (sqrt (* (* ofs ofs) 2))))
)
我并不是说这是个问题，但这只是众多问题中的一个。 尝试以下操作：
从这里使用SelectionSet边界框。 它工作得很好。虽然它没有把盒子放在我目前的线型刻度“12”上。我该怎么做。我更改了一些内容，以便将其放在不同的层上。
(defun c:f6 ( / _offsetoutside _corners->list ss )
;; © Lee Mac 2011
(defun _offsetoutside ( a b )
(mapcar
(function
(lambda ( b c )
(mapcar
(function
(lambda ( b c ) ((eval b) c a))
)
b c
)
)
)
'((- -) (+ -) (+ +) (- +))
b
)
)
(defun _corners->list ( a b )
(mapcar
(function
(lambda ( a b ) (list (car a) (cadr b)))
)
(list a b b a) (list a a b b)
)
)
(setq clyr (getvar "clayer"))
(command "-layer" "m" "Face 6" "c" "red" "" "lt" "Dashed" "Face 6" "")
(if (setq ss (ssget '((0 . "~VIEWPORT"))))
(entmakex
(append
(list
(cons 0 "LWPOLYLINE")
(cons 100 "AcDbEntity")
(cons 100 "AcDbPolyline")
(cons 8 "Face 6")
(cons 90 4)
(cons 70 1)
)
(mapcar
(function
(lambda ( x ) (cons 10 x))
)
(_offsetoutside 2.0
(apply '_corners->list (LM:SSBoundingBox ss))
)
)
)
)
)
(princ)
(setvar "clayer" clyr)
)
;;--------------=={ SelectionSet BoundingBox }==--------------;;
;; ;;
;;Returns the lower-left and upper-right points of a ;;
;;rectangle bounding all objects in a supplied SelectionSet ;;
;;------------------------------------------------------------;;
;;Author: Lee Mac, Copyright © 2011 - www.lee-mac.com ;;
;;------------------------------------------------------------;;
;;Arguments: ;;
;;ss - SelectionSet for which to return the BoundingBox ;;
;;------------------------------------------------------------;;
;;Returns:Point List decribing BoundingBox (in WCS) ;;
;;------------------------------------------------------------;;
(defun LM:SSBoundingBox ( ss / i l1 l2 ll ur )
(repeat (setq i (sslength ss))
(vla-getboundingbox (vlax-ename->vla-object (ssname ss (setq i (1- i)))) 'll 'ur)
(setq l1 (cons (vlax-safearray->list ll) l1)
l2 (cons (vlax-safearray->list ur) l2)
)
)
(mapcar '(lambda ( a b ) (apply 'mapcar (cons a b))) '(min max) (list l1 l2))
)
(vl-load-com) (princ) 需要以上方面的帮助^^^^ 试试这个：
5
此外，当修改他人编写的代码时，标记您的修改是一种很好的礼仪。 它返回了一个刻度。4、为什么？
你告诉我。。。它使用您的LTSCALE设置。 ltscale是唯一确定虚线类型间距的工具吗？
不，这也取决于线型定义本身。
页:
[1]
2