帮助编辑LISP
大家好，我希望一些AutoLISP专家给我一些建议，如果可能的话，帮助编辑以下LISP。
第一个。LSP为3个帖子的parti制作了几个矩形，效果非常好！！
直到做出一些调整以获得第二个。LSP，问题正是这样。
这LSP有几个问题。第一个问题是它失去了第一个的本质，即由它生成的矩形，这取决于
因此，如果测量单位发生变化，则拾取点P1 P2 P3，错误地制作矩形
程序有一些错误，
我还认为这个程序有点重，每次我们运行这个程序都会崩溃。
如果这些问题都解决了，那就太完美了。
但是我们会纠正更多的问题，如果可能的话，我想做一些改进。
我希望矩形的“土地”是在“青色”和所有其他的“红色”的颜色。
2º“青色”矩形位于“01”层，“红色”矩形位于“02”层。
3和矩形内的标签（“00”“00*蓝色”“构造”“地形”）以标签的确切颜色放置在层03 04 05 06上。
第四，在所有的矩形之后，我将爆炸，并希望它位于上面提到的层中。
提前感谢您的帮助，并为英语道歉，我住在巴西，翻译不正确。
/////////////////////////////LISP 01/////////////////////////////
(defun c:Subdivide ( / *error* vars vals p1 p2 p3 p4 ang n w)
(gc)
(vl-load-com)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
(defun *error* (error)
(mapcar 'setvar vars vals)
(vla-endundomark *doc*)
(cond
((not error))
((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
(1 (princ (strcat "\nERROR: " error)))
)
(princ)
)
(vla-endundomark *doc*)
(vla-startundomark *doc*)
(setq vars '("cmdecho" "osmode"))
(setq vals (mapcar 'getvar vars))
(mapcar 'setvar vars '(0 0))
(command "_.expert" (getvar "expert")) ;; dummy command
(and
(setq p1 (getpoint "\nP1 <Início da Edificação>: "))
(setq p2 (getpoint p1 "\nP2 <Comprimento da Edificação>: "))
(setq p3 (getpoint p2 "\nP3 <Comprimento da Quadra>: "))
(or
(not (equal (angle p1 p2)(angle p1 p3) 1e-4))
(alert "\nPoints are all in a straight line.")
)
(not (initget 7))
(setq n (getint "\nEnter quantity of parcels to create: "))
(setq ang (angle p2 p3))
(setq w (/ (distance p2 p3) n))
(repeat n
(setq p3 (polar p2 ang w)
p4 (polar p1 ang w)
)
(vl-cmdf "_.pline" p2 p3 p4 p1 "_C")
(setq p2 p3 p1 p4)
)
)
(*error* nil)
)
(defun c:SD ()(c:Subdivide))
/////////////////////////////LISP 02/////////////////////////////
(defun c:Subdivide( / *error* bmakerec3vs vars vals ucsf p1 p2 p3 k n w h bnn )
(gc)
(vl-load-com)
(or *acad* (setq *acad* (vlax-get-acad-object)))
(or *doc* (setq *doc* (vla-get-ActiveDocument *acad*)))
(defun *error* ( error )
(mapcar 'setvar vars vals)
(if ucsf
(command-s "_.UCS" "_P")
)
(vla-endundomark *doc*)
(cond
((not error))
((wcmatch (strcase error) "*QUIT*,*CANCEL*"))
(1 (princ (strcat "\nERROR: " error)))
)
(princ)
)
(defun bmakerec3vs ( w h ts bn / p ss )
(setq ss (ssadd))
(vl-cmdf "_.RECTANGLE" '(0.0 0.0) (list w h))
(ssadd (entlast) ss)
(setq p (list (/ w 4.0) (/ h 2.0)))
(vl-cmdf "_.TEXT" "_J" "_ML" p ts "" "00")
(ssadd (entlast) ss)
(vl-cmdf "_.BLOCK" bn '(0.0 0.0) ss)
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(if (or (not (entlast)) (and (entlast) (not (ssmemb (entlast) ss))))
(progn
(vl-cmdf "_.INSERT" bn '(0.0 0.0))
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
)
)
(vl-cmdf "_.BEDIT" bn)
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(vl-cmdf "_.CHANGE" "_ALL" "" "_P" "_C" "3")
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(vl-cmdf "_.BPARAMETER" "_V" p)
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(vl-cmdf "_.-BVSTATE" "_N" "Edificações" "_C")
(vl-cmdf "_.-BVSTATE" "_D" "VisibilityState0")
(vl-cmdf "_.-BVSTATE" "_N" "Construções" "_H")
(setq ss (ssadd))
(vl-cmdf "_.RECTANGLE" '(0.0 0.0) (list w h))
(ssadd (entlast) ss)
(vl-cmdf "_.TEXT" "_J" "_ML" p ts "" "Construção")
(ssadd (entlast) ss)
(vl-cmdf "_.CHANGE" ss "" "_P" "_C" "2")
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(vl-cmdf "_.-BVSTATE" "_N" "Terrenos" "_H")
(setq ss (ssadd))
(vl-cmdf "_.RECTANGLE" '(0.0 0.0) (list w h))
(ssadd (entlast) ss)
(vl-cmdf "_.TEXT" "_J" "_ML" p ts "" "Terreno")
(ssadd (entlast) ss)
(vl-cmdf "_.CHANGE" ss "" "_P" "_C" "4")
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(vl-cmdf "_.-BVSTATE" "_N" "Comércios" "_H")
(setq ss (ssadd))
(vl-cmdf "_.RECTANGLE" '(0.0 0.0) (list w h))
(ssadd (entlast) ss)
(vl-cmdf "_.TEXT" "_J" "_ML" p ts "" "00")
(ssadd (entlast) ss)
(vl-cmdf "_.CHANGE" ss "" "_P" "_C" "5")
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(vl-cmdf "_.BCLOSE")
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(princ)
)
(or *k* (setq *k* 0))
(vla-endundomark *doc*)
(vla-startundomark *doc*)
(if (= 0 (getvar 'worlducs))
(progn
(vl-cmdf "_.UCS" "_W")
(setq ucsf t)
)
)
(setq vars '("cmdecho" "osmode"))
(setq vals (mapcar 'getvar vars))
(mapcar 'setvar vars '(0 0))
(if
(and
(setq p1 (getpoint "\nP1 <Início da Edificação>: "))
(setq p2 (getpoint p1 "\nP2 <Comprimento da Edificação>: "))
(setq p3 (getpoint p2 "\nP3 <Comprimento da Quadra>: "))
(or
(not (equal (angle p1 p2) (angle p1 p3) 1e-4))
(alert "\nPoints are all in a straight line.")
)
(not (initget 7))
(setq n (getint "\nQuantidade de Edificações ou Lotes: "))
(setq h (/ (distance p2 p3) n))
(setq w (distance p1 p2))
)
(progn
(bmakerec3vs w h (/ h 4.0) (setq bnn (strcat "rec" (itoa (setq *k* (1+ *k*)))))) ;;;; Especifique diferentes textos em vez de (/ h 4.0) e seu nome exclusivo para bloco em vez de "rec" (você pode deixá-lo como novos nomes de blocos serão criados de acordo com o incremento da variável global * k *)
(entdel (entlast))
(vl-cmdf "_.UCS" "_3P" p2 p1)
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
(setq k -1)
(repeat n
(vl-cmdf "_.INSERT" bnn (list 0.0 (* h (setq k (1+ k)))))
(while (< 0 (getvar 'cmdactive)) (vl-cmdf ""))
)
(vl-cmdf "_.UCS" "_P")
)
)
(*error* nil)
)
(defun c:SD nil (c:Subdivide))
细分。lsp
tmp。lsp 大家好，
我希望一些AutoLISP专家给我一些建议，如果可能的话，帮助编辑以下LISP。
第一个。LSP为3个帖子的parti制作了几个矩形，效果非常好！！
直到做出一些调整以获得第二个。LSP，问题正是这样。
这LSP有几个问题。第一个问题是它失去了第一个的本质，即由它生成的矩形，这取决于
因此，如果测量单位发生变化，则拾取点P1 P2 P3，错误地制作矩形
程序有一些错误，
我还认为这个程序有点重，每次我们运行这个程序都会崩溃。
如果这些问题都解决了，那就太完美了。
但是我们会纠正更多的问题，如果可能的话，我想做一些改进。
我希望矩形的“土地”是在“青色”和所有其他的“红色”的颜色。
2º“青色”矩形位于“01”层，“红色”矩形位于“02”层。
3和矩形内的标签（“00”“00*蓝色”“构造”“地形”）以标签的确切颜色放置在层03 04 05 06上。
第四，在所有的矩形之后，我将爆炸，并希望它位于上面提到的层中。
提前感谢您的帮助，并为英语道歉，我住在巴西，翻译不正确。
细分。lsp
tmp。lsp 霍拉·朱尼尔，埃斯佩罗·诺斯·波达莫斯·恩坦德·恩图尼奥尔，杰耶
Por favor sube el dwg que has utilizado con el LiSP
devitg@gmail.com 请阅读代码发布指南，以后将您的代码放入代码标签中。
Your Code Here=
Your Code Here 好的，谢谢。 Oi@obrigado pela a ajuda，vou tentar me expressar melhor em portugues ou espanhou，
o que estou querendoéuma tarefa um pouco complaada no meu ponto de vista。
埃西姆·蒂尼奥·杜亚斯。lisp a primeiraéa inicial，ela functiona perfeitante，vou adicionar o video com o nome（视频“primeira LSP”）
没有视频。
foram feitas algumas alteraões e o resultado foi a segunda lisp，ela conta com alguns problemas，bugs entre outros，eu gostaria que a segunda mantesse o mesmo princiio da primera。se conseguir fazer isso，jáestaria perfeito。（视频“segunda LSP”）
alem do fato de que se for alterada a unidade medida ela apresenta um bug。
https://drive.google.com/file/d/1P2qgD-765O7z3dQtRXRtIHw-pvCT_DIP/view
https://drive.google.com/file/d/1Z914kQVntb1ZUoSUW-WlR9M0mw-cXp05/view @JuniorNogueira：
为什么你把同一个问题贴了两次？ 无意中。是我的第一个帖子，我不太了解这个网站。 请使用英语。
这是“规则”吗？我很确定他在和说同一种语言的devitg说话。
页:
[1]
2