Rev云矩形故障
我有一个Lisp程序的地方,你画一个矩形,这是一个RevCloud。。。唯一的问题是,当矩形穿过一条线时,弧会表现得很疯狂。。。
有人能告诉我为什么和/或如何修复吗?
Lisp也包括在这里
(prompt "Loading CLOUD1....")
;
(defun C:Cloud1 (/ ds plw pt1 pt2 p1 p2 xdist ydist spcsx spcsy ent1 ent2
nxt info bulge data)
(setq #exlyr (getvar "clayer"))
(if (null (tblsearch "layer" "RevCloud"))
(command "-layer" "m" "RevCloud" "c" "1" "" ""))
(command "-layer" "s" "RevCloud" "")
(setq oldplinewid (getvar"plinewid")) ;get old Plinewidth
setting
(setq OldPlineType (getvar "Plinetype")) ;get old
Plinetype setting
(setvar "Plinetype" 0) ;set Plinetype
to R13 setting
(setvar "cmdecho" 0)
(setq ds (getvar "LTSCALE")
plw (* 0.00 ds)
oer *error*
bm (getvar "blipmode"))
(defun *error* (s) ;start error routine
(setvar "blipmode" bm) ;reset blipmode
(princ (strcat "\Exit..." s)) ;type error message
(if oer (setq *error* oer))
(princ))
(SETQ PT1 (GETPOINT "Pick lower left corner of window: ")) (terpri)
(setq pt2 (getcorner pt1 "Pick upper right corner of window: "))
(setvar "blipmode" 0)
(setq p1 (car pt1) p2 (car pt2) ;find x distances
xdist (- p2 p1))
(setq p1 (cadr pt1) p2 (cadr pt2) ;find y distances
ydist (- p2 p1))
;******TO ADJUST SPACING OF ARCS CHANGE THE NUMBER 2 IN THE NEXT TWO
LINES*****
(setq spcsx (/ (abs xdist) (/ ds 4)) ;X spacing
spcsy (/ (abs ydist) (/ ds 4))) ;Y spacing
(if (= spcsx (fix spcsx)) (setq spcsx (fix spcsx)) (setq spcsx (+ 1 (fix
spcsx))))
(if (= spcsx 1) (setq spcsx 2)) ;min of 2 spaces
(if (= spcsy (fix spcsy)) (setq spcsy (fix spcsy)) (setq spcsy (+ 1 (fix
spcsy))))
(if (= spcsy 1) (setq spcsy 2)) ;min of 2 spaces
(setq xdist (/ xdist spcsx) ydist (/ ydist spcsy)) ;set distances
(setq p1 pt1) ;set polyline start point
(command "PLINE" p1 "W" plw "") ;start polyline command
(repeat spcsx ;draw bottom line segments
(setq p1 (polar p1 0.0 (abs xdist)))
(command p1))
(repeat spcsy ;draw right line segments
(setq p1 (polar p1 (/ pi 2) (abs ydist)))
(command p1))
(repeat spcsx ;draw top line segments
(setq p1 (polar p1 pi (abs xdist)))
(command p1))
(repeat (- spcsy 1) ;draw left line segments
(setq p1 (polar p1 (* pi 1.5) (abs ydist)))
(command p1))
(command "C") ;Close polyline
(setq ent1 (entlast) ;get entity
ent2 (entget ent1) ;get entity info
;******TO ADJUST THE ARC SIZE ADJUST THE 0.7 BELOW*******
bulge (list (cons 42 0.5)) ;build cloud arcs
nxt (cdr (assoc -1 ent2)) ;set for lookup
nxt (entnext nxt) ;get next one
plw (list (cons 41 plw))) ;build cloud width
(while nxt ;start loop
(setq info (entget nxt) ;get exist. info
info (append info bulge) ;set bulge
info (append info plw) ;set width
) ;end of setq
(entmod info) ;modify entity
(setq nxt (entnext nxt)) ;get next segment
) ;end of while
(entupd ent1) ;update entity
(setvar "blipmode" bm) ;reset blipmode
(setvar "cmdecho" 1) ;turn command echo on
(gc) (princ) ;print blank line
(setvar "Plinetype" OldPlineType) ;set Plinetype
setting back
(setvar "Plinewid" OldPlinewid)
(setvar "clayer" #exlyr)
) ;End program
errorlinecloud1。lsp 检查你的osnap是否打开?
gr.Rlx 是的,我的OSNAP也在。。。在较大比例的图形上出现更多,例如1/8“=1’-0”
只是好奇你为什么会想到奥斯奈普 嗯,我曾经写过一个cloud util,当它最终击中我时,它有时也会变得疯狂,因为osnap是罪魁祸首。所以现在我首先禁用osnap,然后让我的应用程序运行它的cource,然后将osnap恢复到其原始模式
gr.Rlx 这就是为什么。。。有人知道为什么会发生这种情况吗?只是好奇
所以现在我有了
(setq oldos (getvar "OSMODE"))
(setvar "OSMODE" 0)
...code...
(setvar "OSMODE" oldos)
如果有人能帮我处理一个错误,如果代码结束,osmode将返回其原始值,我将不胜感激。(不幸的是,我从未做过错误处理) 我看到您在最后已经有了一个错误处理程序,所以只需将osnap放在blip旁边:-)
p、 在应用程序开始时,将getvar放在*error*之外。。。
gr.Rlx 似乎太过分了。。。为什么不制作一条多段线,然后使用“revcloud”>“object”选项? 是的,我从别人那里得到了密码
谢谢你指出这将节省我一些步骤这个周末。。。
还有commandobill。。。因为少了五步
我知道我不必键入矩形
类型revcloud
选择对象
选择对象
然后更改图层 代码写得有点过分,但我没有写,我不介意 我这里没有我的最新版本,但我会在一个单独的线程中发布我的云版本
gr.Rlx
页:
[1]
2