用户在LIS内移动对象

Glen Smith · 发表于 2022-7-6 11:59:51

我正在修改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.)
[color=Red]         (command "_MOVE"  Obj (SETQ BPNT (GETPOINT "\nPick base point: ")) (SETQ DPNT (GETPOINT "\nPick destination point: ")))
[/color]            )))
    (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命令，选择基点和目标点，然后转到下一个对象。但很明显我做错了什么。

提前感谢，
格伦

Lee Mac · 发表于 2022-7-6 12:06:52

完全未经测试，但应该给你的想法。

我还改进了代码的其他部分。。。不知道我第一次写这篇文章的时候在想什么。。。

copy


(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)))

Glen Smith · 发表于 2022-7-6 12:09:03

当我因为LISP编辑器被锁定而关闭并重新启动AutoCAD时，Lee发布了一个解决我问题的方法。非常感谢。

我冒昧地注释掉了“你想移动它吗”的问题，发现如果你不想移动当前对象，只需点击回车键，就可以进入下一个对象。我还添加了撤销作为组码，这样我可以一次撤销所有动作。

更新代码：

copy


(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)))

李

Lee Mac · 发表于 2022-7-6 12:14:29

我没有办法测试这个，但你不能用vla move吗？

copy


(defun c:zmblk (/ *error* StrBrk *ACAD BPNT DOC DPNT ELST FILE
                                LST MAXP MINP NL OFILE PTS UFLAG)
 (vl-load-com)
[color=Red][b]  (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))[/b][/color]
 (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)))
           [color=Red][b]uflag[/b][/color] (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)))
     [color=Red][b](setq ofile[/b][/color] (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))))
     [b][color=Red](setq uflag[/color][/b] (vla-EndUndoMark doc)))
   
 (princ "\n<< No File Selected >>"))
 (princ))