[shartal]

На форуме есть лисп вставляющий в ячейку таблицу поле с длиной. Возможно ли такой же для вставки в ячейку координат точки вставки блока? В метрах и до третьего знака.

[Oliver_88]

Запуск (test).

Код:

[Выделить все]

 (vl-load-com)
  (setq active_document (vla-get-activedocument (vlax-get-acad-object)))
  (defun test (/ a b table )
    (setq table (bes-getentity "\Выберите таблицу: "))
    (vla-HitTest
      table
      (bes-getpoint "\nВыберите ячейку таблицы: ")
      (vlax-3D-point '(0.0 0.0 1.0))
      'a
      'b
      )
    (vla-SetText
      table
      a
      b
      (vl-string-subst
	(itoa(vla-get-ObjectID (bes-getentity "\nВыберите блок: ")))
	"2129171864"
	"%<\\AcObjProp Object(%<\\_ObjId 2129171864>%).InsertionPoint \\f \"%lu2%pr3\">%"
	)
      )
    )
  (defun bes-getentity (str / obj util a b)
    (setq util
	   (vla-get-Utility
	     active_document
	     )
	  )
    (if
      (not
	(vl-catch-all-error-p
	  (setq obj
		 (vl-catch-all-apply
		   'vla-GetEntity
		   (list util 'a 'b str)
		   )
		)
	  )
	)
      a
      )
    )
  (defun bes-getpoint (str / obj util)
    (setq util
	   (vla-get-Utility
	     active_document
	     )
	  )
    (if
      (not
	(vl-catch-all-error-p
	  (setq obj
		 (vl-catch-all-apply
		   'vla-GetPoint
		   (list util nil str)
		   )
		)
	  )
	)
      obj
      )
    )

А вот ручками покажи как сделать "в метрах".

[Кулик Алексей aka kpblc]

Oliver_88, пара замечаний:
1. В 64-разрядной версии AutoCAD работать не будет в принципе
2. В новом документе результат будет неверным, если будет вообще.
См. http://autolisp.ru/2010/05/30/field-proceed-2/ и http://autolisp.ru/2011/07/07/x32x64objectid/

[Oliver_88]

Кулик Алексей aka kpblc, спасибо за замечания и ссылки. Offtop: Вообще очень много полезного узнал с твоего сайта.
1. Про 64 не знал. Как-то неловко пользоваться чужими кодами поэтому вставлять в свой код не буду.
2. Я делал именно в новом, все работало.

[DEM]

тут в принципе и программирование не требуется. Можно воспользоваться таблицей из СПДС-графикс...

[Кулик Алексей aka kpblc]

Сообщение от Oliver_88 Как-то неловко пользоваться чужими кодами

Кха, у меня не меньше половины чужих, и ничего - живу А для чего тогда они выкладываются?
DEM, подари пару сотен рабочих мест!

[shartal]

Внимательно ознакомился со ссылками, но код исправить под 64 не получилось.

[Oliver_88]

shartal, извиняй. Нет x64. Так бы сделал.

[Кулик Алексей aka kpblc]

Код:

[Выделить все]

 (vl-load-com)

(defun test (/ fun_save-sysvars fun_restore-sysvars sysvars adoc tbl pt ent)

  ;;--------------------------------------------------------
;; Функция получает строковое представление ObjectID
;; вне зависимости от того AutoCAD x86 или x64
;; Источник: https://discussion.autodesk.com/forums/message.jspa?messageID=6172961
;;--------------------------------------------------------
(defun get-objectid-x86-x64 (obj / util)
  (setq util (vla-get-utility (vla-get-activedocument (vlax-get-acad-object))))
  (if (= (type obj) 'ename)
    (setq obj (vlax-ename->vla-object obj))
    ) ;_ end of if
  (if (= (type obj) 'vla-object)
    (if (> (vl-string-search "x64" (getvar "platform")) 0)
      (vlax-invoke-method util "GetObjectIdString" obj :vlax-false)
      (rtos (vla-get-objectid obj) 2 0)
      ) ;_ end of if
    ) ;_ end of if
  ) ;_ end of defun
  
  (defun fun_save-sysvars (lst)
    (mapcar
      (function
        (lambda (x / tmp)
          (setq tmp (getvar (car x)))
          (setvar (car x) (cdr x))
          (cons (car x) tmp)
          ) ;_ end of lambda
        ) ;_ end of function
      lst
      ) ;_ end of mapcar
    ) ;_ end of defun

  (defun fun_restore-sysvars (lst)
    (foreach item lst
      (setvar (car item) (cdr item))
      ) ;_ end of foreach
    ) ;_ end of defun

  (defun fun_silence-selset (msg filter / res lst)
    (princ (strcat "\n" msg " <Отмена> : "))
    (setq lst (fun_save-sysvars '(("cmdecho" . 0) ("nomutt" . 1)))
          res (vl-catch-all-apply (function (lambda () (eval (read (strcat "(ssget " filter ")"))))))
          ) ;_ end of setq
    (fun_restore-sysvars lst)
    (princ)
    res
    ) ;_ end of defun

  (if (and (= (type (setq tbl (fun_silence-selset "Выбери таблицу" "\"_+.:S:E:L\" '((0 . \"ACAD_TABLE\"))")))
              'pickset
              ) ;_ end of =
           (equal (vl-catch-all-apply
                    (function
                      (lambda ()
                        (vla-hittest (vlax-ename->vla-object (setq tbl (ssname tbl 0)))
                                     (vlax-3d-point (setq pt (trans (getpoint "\Укажи ячейку <Отмена> : ") 1 0)))
                                     (vlax-3d-point (cdr (assoc 210 (entget tbl))))
                                     'row
                                     'col
                                     ) ;_ end of vla-hittest
                        ) ;_ end of lambda
                      ) ;_ end of function
                    ) ;_ end of vl-catch-all-apply
                  :vlax-true
                  ) ;_ end of equal
           (= (type (setq ent (fun_silence-selset "Выбери блок" "\"_+.:S:E:L\" '((0 . \"INSERT\"))")))
              'pickset
              ) ;_ end of =
           ) ;_ end of and
    (progn
      (vla-startundomark (setq adoc (vla-get-activedocument (vlax-get-acad-object))))
      (vl-catch-all-apply
        (function
          (lambda ()
            (vla-settext (vlax-ename->vla-object tbl)
                         row
                         col
                         (strcat "%<\\AcObjProp Object(%<\\_ObjId "
                                 (get-objectid-x86-x64 (ssname ent 0))
                                 ">%).InsertionPoint \\f \"%lu2%pr3\">%"
                                 ) ;_ end of strcat
                         ) ;_ end of vla-settext
            ) ;_ end of lambda
          ) ;_ end of function
        ) ;_ end of vl-catch-all-apply
      (vla-endundomark adoc)
      ) ;_ end of progn
    ) ;_ end of if
  (princ)
  ) ;_ end of defun

[shartal]

Спасибо, все чудесно.