用户在LIS内移动对象
我正在修改Lee写的LISP，我想做的是遍历一个对象列表，让用户根据美学来移动每个对象。具体来说，我有100个门标识图标，希望放大每个图标，决定是否需要移动图标，如果需要，请移动，然后转到下一个图标。
(defun c:zmblk (/ file nl lst Minp Maxp pts elst BPNT DPNT)
(vl-load-com)
(if (setq file
(getfiled "Select Text File"
(if *load *load "") "txt" )
(progn
(setq *load file file (open file "r"))
(while (setq nl (read-line file))
(princ nl)
(setq lst (cons (car (StrBrk nl 9)) lst)))
(close file)
(princ "\n<< Closed file >>")
(if (setq elst (vl-remove-if 'null
(mapcar 'handent
(mapcar
(function
(lambda (x)
(substr x 2))) (reverse lst)))))
(foreach Obj (mapcar 'vlax-ename->vla-object elst)
(vla-getBoundingBox Obj 'Minp 'Maxp)
(setq pts (mapcar 'vlax-safearray->list (list Minp Maxp)))
(vla-ZoomCenter
(vlax-get-acad-object)
(vlax-3D-point
(polar (car pts)
(apply 'angle pts)
(/ (apply 'distance pts) 2.)))
400.)
(command "_MOVE"Obj (SETQ BPNT (GETPOINT "\nPick base point: ")) (SETQ DPNT (GETPOINT "\nPick destination point: ")))
)))
(princ "\n<< No File Selected >>"))
(princ))
(defun StrBrk (str chrc / pos lst)
(while (setq pos (vl-string-position chrc str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos 2))))
(reverse (cons str lst)))
我需要有关对象实际移动的帮助，李的代码已经放大了对象，所以我认为我应该能够使用该对象和move命令，选择基点和目标点，然后转到下一个对象。但很明显我做错了什么。
提前感谢，
格伦 完全未经测试，但应该给你的想法。
我还改进了代码的其他部分。。。不知道我第一次写这篇文章的时候在想什么。。。
(defun c:zmblk (/ file nl lst Minp Maxp pts elst BPNT DPNT)
(vl-load-com)
(setq *acad (vlax-get-acad-object))
(if (setq file (getfiled "Select Text File" (if *load *load "") "txt" )
(progn
(setq *load file file (open file "r"))
(while (setq nl (read-line file))
(princ nl)
(setq lst (cons (car (StrBrk nl 9)) lst)))
(close file)
(princ "\n<< Closed file >>")
(if (setq elst (vl-remove-if 'null
(mapcar 'handent
(mapcar (function (lambda (x) (substr x 2))) (reverse lst)))))
(foreach Obj (mapcar 'vlax-ename->vla-object elst)
(vla-getBoundingBox Obj 'Minp 'Maxp)
(setq pts (mapcar 'vlax-safearray->list (list Minp Maxp)))
(vla-ZoomCenter *acad
(vlax-3D-point (polar (car pts) (apply 'angle pts) (/ (apply 'distance pts) 2.))) 400.)
(initget "Yes No")
(if (/= "No" (getkword "Move Object? <Yes> : "))
(if (and (setq bPnt (getpoint "\nPick Base point: "))
(setq dPnt (getpoint bPnt "\nPick Destination: ")))
(vl-cmdf "_.move" (vlax-vla-object->ename obj) "" bPnt dPnt))))))
(princ "\n<< No File Selected >>"))
(princ))
(defun StrBrk (str chrc / pos lst)
(while (setq pos (vl-string-position chrc str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos 2))))
(reverse (cons str lst)))
当我因为LISP编辑器被锁定而关闭并重新启动AutoCAD时，Lee发布了一个解决我问题的方法。非常感谢。
我冒昧地注释掉了“你想移动它吗”的问题，发现如果你不想移动当前对象，只需点击回车键，就可以进入下一个对象。我还添加了撤销作为组码，这样我可以一次撤销所有动作。
更新代码：
(defun c:zmblk (/ file nl lst Minp Maxp pts elst BPNT DPNT)
(vl-load-com)
(setq *acad (vlax-get-acad-object))
(if (setq file (getfiled "Select Text File" (if *load *load "") "txt" )
(progn
(setq doc (vla-get-ActiveDocument (vlax-get-acad-object)))
(vla-startUndoMark doc)
(setq *load file file (open file "r"))
(while (setq nl (read-line file))
(princ nl)
(setq lst (cons (car (StrBrk nl 9)) lst)))
(close file)
(princ "\n<< Closed file >>")
(if (setq elst (vl-remove-if 'null
(mapcar 'handent
(mapcar (function (lambda (x) (substr x 2))) (reverse lst)))))
(foreach Obj (mapcar 'vlax-ename->vla-object elst)
(vla-getBoundingBox Obj 'Minp 'Maxp)
(setq pts (mapcar 'vlax-safearray->list (list Minp Maxp)))
(vla-ZoomCenter *acad
(vlax-3D-point (polar (car pts) (apply 'angle pts) (/ (apply 'distance pts) 2.))) 400.)
; (initget "Yes No")
; (if (/= "No" (getkword "Move Object? <Yes> : "))
(if (and (setq bPnt (getpoint "\nPick Base point: "))
(setq dPnt (getpoint bPnt "\nPick Destination: ")))
(vl-cmdf "_.move" (vlax-vla-object->ename obj) "" bPnt dPnt))))) <- extra paren had to go due to removing the 'prompt to move' if function
(princ "\n<< No File Selected >>"))
(vla-EndUndoMark doc)
(princ))
(defun StrBrk (str chrc / pos lst)
(while (setq pos (vl-string-position chrc str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos 2))))
(reverse (cons str lst)))
李 我没有办法测试这个，但你不能用vla move吗？
(defun c:zmblk (/ *error* StrBrk *ACAD BPNT DOC DPNT ELST FILE
LST MAXP MINP NL OFILE PTS UFLAG)
(vl-load-com)
(defun *error* (msg)
(and uFlag (vla-EndUndoMark doc))
(and oFile (close oFile))
(or (wcmatch (strcase msg) "*BREAK,*CANCEL*,*EXIT*")
(princ (strcat "\n** Error: " msg " **")))
(princ))
(defun StrBrk (str chrc / pos lst)
(while (setq pos (vl-string-position chrc str))
(setq lst (cons (substr str 1 pos) lst)
str (substr str (+ pos 2))))
(reverse (cons str lst)))
(if (setq file (getfiled "Select Text File" (if *load *load "") "txt" )
(progn
(setq doc (vla-get-ActiveDocument (setq *acad (vlax-get-acad-object)))
uflag (not (vla-startUndoMark doc)))
(setq *load file ofile (open file "r"))
(while (setq nl (read-line ofile))
(princ nl)
(setq lst (cons (car (StrBrk nl 9)) lst)))
(setq ofile (close ofile))
(if (setq elst (vl-remove-if 'null
(mapcar 'handent
(mapcar (function (lambda (x) (substr x 2))) (reverse lst)))))
(foreach Obj (mapcar 'vlax-ename->vla-object elst)
(vla-getBoundingBox Obj 'Minp 'Maxp)
(setq pts (mapcar 'vlax-safearray->list (list Minp Maxp)))
(vla-ZoomCenter *acad
(vlax-3D-point (polar (car pts) (apply 'angle pts) (/ (apply 'distance pts) 2.))) 400.)
(if (and (setq bPnt (getpoint "\nPick Base point: "))
(setq dPnt (getpoint bPnt "\nPick Destination: ")))
(vl-cmdf "_.move" (vlax-vla-object->ename obj) "" bPnt dPnt))))
(setq uflag (vla-EndUndoMark doc)))
(princ "\n<< No File Selected >>"))
(princ))
是的，我在那里有点像隧道视觉。。。。 我总是这样做。
前几天我写了一些类似于20-30行代码的东西。我一写完，就看了看，按CTRL+a和Backspace键，把它改写成3行。 不过我喜欢你的方法。。厚脸皮的lambda函数 谢谢，只是尽量减少打字。
幸运的是我们在Lisp程序。。。我看到了Arx公司生产的一系列产品。。。。 别开玩笑了。对于一些试图从Lisp跳到C的人来说，这有点令人畏惧。
页:
[1]
2