| Правила | Регистрация | Пользователи | Поиск | Сообщения за день | Все разделы прочитаны |  Справка по форуму | Файлообменник |

Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужна помощь по изменению лиспа "Вставка пикетажа" в лисп "вставка плюсовой точки"

Нужна помощь по изменению лиспа "Вставка пикетажа" в лисп "вставка плюсовой точки"

Ответ
Поиск в этой теме
Непрочитано 01.06.2015, 00:17 #1
Нужна помощь по изменению лиспа "Вставка пикетажа" в лисп "вставка плюсовой точки"
sosococo
 
Генланист
 
г.Тюмень
Регистрация: 31.05.2015
Сообщений: 8

Доброго времени суток!
Наткнулся случайно на лисп dpick.lsp, который подписывает пикетаж указанной точки. Это очень удобный лисп, но все же есть необходимость подписывать отдельно плюсовые точки, например в исходном варианте лиспа подписывает пикетаж вида "ПК15+02,45", а нужно только плюсовую точку, тоесть "+02,45".
Исходный лисп прикладываю ниже

Код:
[Выделить все]
 ;;---------------------------------   dpick.lsp   ------------------------------------;; 

;; fixo () 2012 * all rights released 
;; редакция от 08 авг. 2012 
;; редакция от 14 авг. 2012 

(defun C:DPICK(/ *error* acsp adoc ang ans clay clr clt clw curh curst curve da degs dimz dist div fd hgt kw layerobj 
                leng lnum mul num obj osm par param pick pline plpt prec pref pt sset step style styles txt txtp) 

;;; 
(defun *error* (msg) 
    (if adoc(vla-endundomark adoc)) 
    (cond ((not msg)) 
     ((vl-position 
             msg 
             '("Function cancelled" "quit / exit abort" "console break") 
           ) 
          ) 
          ((princ (strcat "\nDistan Command Error: " msg))) 
    ) 

(if clay (setvar "clayer" clay))   
(if clr (setvar "cecolor" clr)) 
(if clt (setvar "celtype" clt))   
(if clw(setvar "celweight"clw))   
(if osm (setvar "osmode" osm)) 
(if dimz (setvar "dimzin" dimz)) 
   
(setvar "cmdecho" 1) 
    (princ) 
  )   
;;; 
(defun addlayer (adoc layername ltype lweight color / layer) 
       
      (if 
    (not 
      (vl-catch-all-error-p 
        (setq layer 
           (vl-catch-all-apply 
             'vla-add 
             (list (vla-get-layers adoc) layername) 
           ) 
        ) 
      ) 
    ) 
    (progn 
      (vl-catch-all-apply 'vla-put-linetype (list layer ltype));; если тип линии не загружен, используется continuous по умолчанию 
      (if (and (>= lweight -3 )(<= lweight 211));; значение в интервале  -3...211 (согласно валидным значениям) 
      (vl-catch-all-apply 'vlax-put (list layer 'lineweight lweight))) 
      (if (and (>= color 0 )(< color 256));; значение в интервале  0...255, 256 для слоя не используется 
      (vl-catch-all-apply 'vlax-put (list layer 'color color)))) 
     
      ) 
   layer 
) 
;;; 
(defun angtangent (pline pt) 
  ;; by Charles Alan Butler aka CAB 
  (angle 
    '(0 0 0) 
    (trans 
      (vlax-curve-getFirstDeriv 
        pline 
        (vlax-curve-getParamAtPoint pline (trans pt 1 0)) 
      ) 
      0 1 T 
    ) 
  ) 
) 
  ;; Создание стиля текста, если он отсутствует в документе 
;; пример: 
;;;(add-textsyle adoc 
;;;  "ANNO-GIS-TEXT"; имя стиля текста 
;;;  "ISOCPEUR" ; имя шрифта без расширения (если его нет, тогда будет по умолчанию, скорей всего "ARIAL" 
;;;  nil ; если nil тогда нежирный, если Т тогда жирный 
;;;  nil ; если nil тогда обычный, если Т тогда курсив 
;;;  0.0 ; высота текста 
;;;  0.75; ширина букв 
;;;  ) 


;;;   
(defun add-textsyle(adoc name font bold italic height width) 
(setq styles(vla-get-textstyles  adoc)) 
  (if (not (tblsearch "style" name)) 
    (progn 
      (vl-catch-all-apply 'vla-add (list styles   name)) 
      (vl-catch-all-apply 
   '(lambda () 
      (vla-setfont 
        (setq style (vla-item 
          styles 
          name 
        ) 
         ) 
        font ; font name 
        (if bold 
          :vlax-true 
          :vlax-false 
        ) ; non-bold (otherwise :vlax-true) 
        (if italic 
          :vlax-true 
          :vlax-false 
        ) ; italic (otherwise :vlax-false) 
        0 ; symbol's flag 
        32 ; sum of flag values for ticks and characters 
      ) 
    ) 
      ) 
      (vl-catch-all-apply 'vla-put-height  (list style   height)) 
      (vl-catch-all-apply 'vla-put-width  (list style   width)) 
    ) 
  ) 
(princ) 
) 
   (defun distatparam (curve param) 
  (vl-catch-all-apply (function (lambda() 
  (vlax-curve-getdistatparam curve 
  param 
  ) 
  ) 
            ) 
    ) 
  ) 
;;; 
(defun pointoncurve (curve pt) 
  (vl-catch-all-apply (function (lambda() 
  (vlax-curve-getclosestpointto curve 
  pt 
    ) 
  ) 
) 
    ) 
  ) 
   
;;; ------------------------------  Основная программа   -----------------------------------;; 
   
  (setq   adoc (vla-get-activedocument 
          (vlax-get-acad-object) 
        ) 
  ) 
  (if (and 
   (= (getvar "tilemode") 0) 
   (= (getvar "cvport") 1) 
      ) 
    (setq acsp (vla-get-paperspace adoc)) 
    (setq acsp (vla-get-modelspace adoc)) 
  ) 
     (vla-endundomark adoc) 
    (vla-startundomark adoc) 
;;; 
  (defun right-ang(ang /) 
  (if (< (/ pi 2) ang (* pi 1.5)) 
    (setq ang (+ ang pi))) 
    ang 
    ) 
;;; ------------- Системные переменные >  -----------;; 
   
(setq clay (getvar "clayer")) 
(if (not (tblsearch "layer"  "Пикетаж"));<-- измени имя слоя здесь ---------------- 
   
(addlayer adoc "Пикетаж" "bylayer" -3 30));<-- измени имя слоя здесь  ---------------- 

(setq layerobj (vla-item (vla-get-layers adoc) "Пикетаж"));<-- измени имя слоя здесь  ---------------- 

(vl-catch-all-apply 'vla-put-lock (list layerobj :vlax-false)) 
(vl-catch-all-apply 'vla-put-layeron (list layerobj :vlax-true)) 
(vl-catch-all-apply 'vla-put-freeze (list layerobj :vlax-false)) 
   
(setvar "clayer" "Пикетаж");<-- измени имя слоя здесь ---------------- 
   
(setq clr (getvar "cecolor")) 
(setvar "cecolor" "ByLayer") 
   
(setq clt (getvar "celtype"))   
(setvar "celtype" "ByLayer") 
   
(setq clw(getvar "celweight")) 
(setvar "celweight" -1) 
   
(setq osm (getvar "osmode")) 
(setvar "osmode" 513) 
   
(setq dimz (getvar "dimzin")) 
(setvar "dimzin" 0) 
;;; ----------- <  Системные переменные -------------;; 
   
(princ "\nВыбрать кривую : ") 
(if (setq sset (ssget "_:S:E:L" (list (cons 0 "spline,line,*polyline")))) 
(progn 
(setq pline (cadar (ssnamex sset 0))) 
(setq pt (last (cadddr (last (ssnamex sset 0))))) 
;;------------------------------------------------ 
(setq obj (vlax-ename->vla-object pline)) 
     ;; чёрная дыра: 
     (if (and (eq "AcDbSpline" (vla-get-objectname obj))(eq :vlax-false (vla-get-isplanar obj))) 
       (progn 
    (alert "Не работает с некомпланарными сплайнами\n      Выход...") 
    (exit)(princ)) 
       ) 
     
      (setq pt   (pointoncurve pline pt) 
      leng   (distatparam pline (vlax-curve-getendparam pline)) 
      ) 
(while   (not 
     (and 
       (or 
         (initget 6) 
         (setq step (getreal "\nВведите шаг <25>: ")) 
         (if (not step) 
      (setq step 25.))) 
       (zerop (rem 100 step)))) 
   (alert (strcat "\nОстаток от деления 100 на шаг / " (rtos step 2 2) " не равен нулю, 
        \nВведен некорректный шаг")) 
   ) 


     (setq num (fix (/ leng step)) 
      ) 

     (setq div (fix (/ 100. step) 
          ) 
      ) 

     (setq mul (- leng 
        (* (setq lnum (fix (/ leng (* step div)))) (* step div)))) 

;;--------------------------------------------- 
(setq curh (getvar "textsize")) 
(setq curst (getvar "textstyle")) 
  (initget "Да Нет Yes No") 
(setq kw (getkword (strcat "\nИспользовать текущий стиль  текста " "\"" curst "\"" " ? " " [Да/Нет] <Да>: "))) 
(if (or (eq "No" kw)(eq "Нет" kw)) 
   
(if (not (eq "" 
(setq curst (getstring t "\nВведите имя нужного стиля текста: ")))) 
   
(add-textsyle adoc curst "simplex" nil nil 0.0 0.8);<-- измени имя шрифта здесь ---------------- 
  ) 
  ) 


   (initget  "Yes No ") 
   (setq ans (getkword "\nВставить префикс? (Y/N) <Y>:")) 
   (setq pref  (if (not ans )(lisped   "ПК") "")) 

(initget 6) 
(setq hgt (getreal (strcat "\nЗадайте высоту текста <" (rtos curh 2 1) ">: "))) 
(if (not hgt)(setq hgt curh)) 
(initget 6) 
(setq prec (getint (strcat "\nЗадайте число десятичных знаков <3>: "))) 
(if (not prec)(setq prec 3)) 
(while (setq pick (getpoint "\nУказать точку на кривой (Enter для завершения): ")) 

(setq plpt (vlax-curve-getclosestpointto pline pick)) 
(setq par (vlax-curve-getparamatpoint pline plpt)) 
(setq dist (vlax-curve-getdistatparam pline par)) 
(setq fd (vlax-curve-getfirstderiv pline par)) 
(setq ang (angtangent pline plpt) 
      degs (* 180 (/ ang pi))) 
   
  (setvar "osmode" 513) 

  (setq txtp plpt) 
  (setq da (right-ang (angtangent pline txtp))) 
  (setq txtp (polar txtp (+ da (/ pi 2))(/ hgt 2))) 

(princ (strcat "\nX : " (rtos (car plpt) 2 prec) 
          "\nY : " (rtos (cadr plpt) 2 prec) 
          "\nZ : " (rtos (caddr plpt) 2 prec) 
          "\nРасстояние : " (rtos dist 2 prec) 
          "\nУгол : " (rtos degs 2 prec))) 

    (setq txt (vla-addtext acsp 
      (if (< dist step)(strcat pref "0+" (if (< (fix (- dist (* (fix (/ dist step)) step))) 10)"0" "")(rtos dist 2  prec)) 
  (strcat pref  (itoa (fix (/ dist step)))"+" 
     (if (< (fix (- dist (* (fix (/ dist step)) step))) 10)"0" "") 
     (rtos (- dist (* (fix (/ dist step)) step))2  prec))) 
      (vlax-3d-point txtp) 
      hgt) 
     ) 

  (vla-put-alignment txt acalignmentbottomcenter) 
   
  (vla-put-textalignmentpoint txt (vlax-3d-point txtp)) 
   
  (vla-put-insertionpoint txt (vla-get-textalignmentpoint txt)) 
   
  (vla-put-rotation txt da) 
  (vla-put-stylename txt curst) 


  (setvar "osmode" 513) 
  ) 
) 
      ) 

(vla-endundomark adoc) 
  (*error* nil) 
(princ) 
) 
(prompt "\n   ---   команда на выполнение \"DPICK\" или \"dpick\"  ---") 
(prin1) 
(or (vl-load-com) 
(princ) 
    ) 

;;----------------------------------  end of dpick.lsp   --------------------------------;;

Последний раз редактировалось Кулик Алексей aka kpblc, 01.06.2015 в 09:06.
Просмотров: 2756
 
Непрочитано 01.06.2015, 09:07
#2
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


На чем сам споткнулся?
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Непрочитано 01.06.2015, 11:14
#3
gomer

строю, ломаю
 
Регистрация: 03.04.2008
Украина
Сообщений: 5,515


Цитата:
Сообщение от Кулик Алексей aka kpblc Посмотреть сообщение
На чем сам споткнулся?
К сожалению автор программы пропал, а программу нужно допиливать и исправлять. По хорошему нужно сделать нормальный диалог с настройками. Это довольно много работы и бесплатно вряд ли кто согласится. Так что лучше обратиться сюда
gomer вне форума  
 
Автор темы   Непрочитано 01.06.2015, 15:20
#4
sosococo

Генланист
 
Регистрация: 31.05.2015
г.Тюмень
Сообщений: 8


сам я в программировании ничего не понимаю, я предполагаю, что в лиспе вычисляется отдельно пикет и плюсовая точка, а потом сцепляются вместе, как это я в экселе делаю =СЦЕПИТЬ("ПК";ОКРУГЛВНИЗ(L/100;0);"+";ЕСЛИ(L-ОКРУГЛВНИЗ(L/100;0)*100<10;"0";"");L-ОКРУГЛВНИЗ(L/100;0)*100), я думаю, что нужно откинуть часть текста , отставив =СЦЕПИТЬ("+";ЕСЛИ(L-ОКРУГЛВНИЗ(L/100;0)*100<10;"0";"");L-ОКРУГЛВНИЗ(L/100;0)*100))....
возможно вывод значения таится в строках 274 - 280, но как удалить лишнее, чтобы код работал.....
или я далек от истинны?

Последний раз редактировалось sosococo, 01.06.2015 в 16:45.
sosococo вне форума  
 
Автор темы   Непрочитано 15.06.2015, 11:31 спасибо , что дали возможность сделать самому
#5
sosococo

Генланист
 
Регистрация: 31.05.2015
г.Тюмень
Сообщений: 8


Код:
[Выделить все]
 ;;---------------------------------   dpick2.lsp   ------------------------------------;; 

;; fixo () 2012 * all rights released 
;; редакция от 08 авг. 2012 
;; редакция от 14 авг. 2012 

(defun C:DPICK2(/ *error* acsp adoc ang ans clay clr clt clw curh curst curve da degs dimz dist div fd hgt kw layerobj 
                leng lnum mul num obj osm par param pick pline plpt prec pref pt sset step style styles txt txtp) 

;;; 
(defun *error* (msg) 
    (if adoc(vla-endundomark adoc)) 
    (cond ((not msg)) 
     ((vl-position 
             msg 
             '("Function cancelled" "quit / exit abort" "console break") 
           ) 
          ) 
          ((princ (strcat "\nDistan Command Error: " msg))) 
    ) 

(if clay (setvar "clayer" clay))   
(if clr (setvar "cecolor" clr)) 
(if clt (setvar "celtype" clt))   
(if clw(setvar "celweight"clw))   
(if osm (setvar "osmode" osm)) 
(if dimz (setvar "dimzin" dimz)) 
   
(setvar "cmdecho" 1) 
    (princ) 
  )   
;;; 
(defun addlayer (adoc layername ltype lweight color / layer) 
       
      (if 
    (not 
      (vl-catch-all-error-p 
        (setq layer 
           (vl-catch-all-apply 
             'vla-add 
             (list (vla-get-layers adoc) layername) 
           ) 
        ) 
      ) 
    ) 
    (progn 
      (vl-catch-all-apply 'vla-put-linetype (list layer ltype));; если тип линии не загружен, используется continuous по умолчанию 
      (if (and (>= lweight -3 )(<= lweight 211));; значение в интервале  -3...211 (согласно валидным значениям) 
      (vl-catch-all-apply 'vlax-put (list layer 'lineweight lweight))) 
      (if (and (>= color 0 )(< color 256));; значение в интервале  0...255, 256 для слоя не используется 
      (vl-catch-all-apply 'vlax-put (list layer 'color color)))) 
     
      ) 
   layer 
) 
;;; 
(defun angtangent (pline pt) 
  ;; by Charles Alan Butler aka CAB 
  (angle 
    '(0 0 0) 
    (trans 
      (vlax-curve-getFirstDeriv 
        pline 
        (vlax-curve-getParamAtPoint pline (trans pt 1 0)) 
      ) 
      0 1 T 
    ) 
  ) 
) 
  ;; Создание стиля текста, если он отсутствует в документе 
;; пример: 
;;;(add-textsyle adoc 
;;;  "ANNO-GIS-TEXT"; имя стиля текста 
;;;  "ISOCPEUR" ; имя шрифта без расширения (если его нет, тогда будет по умолчанию, скорей всего "ARIAL" 
;;;  nil ; если nil тогда нежирный, если Т тогда жирный 
;;;  nil ; если nil тогда обычный, если Т тогда курсив 
;;;  0.0 ; высота текста 
;;;  0.75; ширина букв 
;;;  ) 


;;;   
(defun add-textsyle(adoc name font bold italic height width) 
(setq styles(vla-get-textstyles  adoc)) 
  (if (not (tblsearch "style" name)) 
    (progn 
      (vl-catch-all-apply 'vla-add (list styles   name)) 
      (vl-catch-all-apply 
   '(lambda () 
      (vla-setfont 
        (setq style (vla-item 
          styles 
          name 
        ) 
         ) 
        font ; font name 
        (if bold 
          :vlax-true 
          :vlax-false 
        ) ; non-bold (otherwise :vlax-true) 
        (if italic 
          :vlax-true 
          :vlax-false 
        ) ; italic (otherwise :vlax-false) 
        0 ; symbol's flag 
        32 ; sum of flag values for ticks and characters 
      ) 
    ) 
      ) 
      (vl-catch-all-apply 'vla-put-height  (list style   height)) 
      (vl-catch-all-apply 'vla-put-width  (list style   width)) 
    ) 
  ) 
(princ) 
) 
   (defun distatparam (curve param) 
  (vl-catch-all-apply (function (lambda() 
  (vlax-curve-getdistatparam curve 
  param 
  ) 
  ) 
            ) 
    ) 
  ) 
;;; 
(defun pointoncurve (curve pt) 
  (vl-catch-all-apply (function (lambda() 
  (vlax-curve-getclosestpointto curve 
  pt 
    ) 
  ) 
) 
    ) 
  ) 
   
;;; ------------------------------  Основная программа   -----------------------------------;; 
   
  (setq   adoc (vla-get-activedocument 
          (vlax-get-acad-object) 
        ) 
  ) 
  (if (and 
   (= (getvar "tilemode") 0) 
   (= (getvar "cvport") 1) 
      ) 
    (setq acsp (vla-get-paperspace adoc)) 
    (setq acsp (vla-get-modelspace adoc)) 
  ) 
     (vla-endundomark adoc) 
    (vla-startundomark adoc) 
;;; 
  (defun right-ang(ang /) 
  (if (< (/ pi 2) ang (* pi 1.5)) 
    (setq ang (+ ang pi))) 
    ang 
    ) 
;;; ------------- Системные переменные >  -----------;; 
   
(setq clay (getvar "clayer")) 
(if (not (tblsearch "layer"  "АД_пикетаж"));<-- измени имя слоя здесь ---------------- 
   
(addlayer adoc "АД_пикетаж" "bylayer" -3 30));<-- измени имя слоя здесь  ---------------- 

(setq layerobj (vla-item (vla-get-layers adoc) "Пикетаж"));<-- измени имя слоя здесь  ---------------- 

(vl-catch-all-apply 'vla-put-lock (list layerobj :vlax-false)) 
(vl-catch-all-apply 'vla-put-layeron (list layerobj :vlax-true)) 
(vl-catch-all-apply 'vla-put-freeze (list layerobj :vlax-false)) 
   
(setvar "clayer" "АД_пикетаж");<-- измени имя слоя здесь ---------------- 
   
(setq clr (getvar "cecolor")) 
(setvar "cecolor" "ByLayer") 
   
(setq clt (getvar "celtype"))   
(setvar "celtype" "ByLayer") 
   
(setq clw(getvar "celweight")) 
(setvar "celweight" -1) 
   
(setq osm (getvar "osmode")) 
(setvar "osmode" 513) 
   
(setq dimz (getvar "dimzin")) 
(setvar "dimzin" 0) 
;;; ----------- <  Системные переменные -------------;; 
   
(princ "\nВыбрать кривую : ") 
(if (setq sset (ssget "_:S:E:L" (list (cons 0 "spline,line,*polyline")))) 
(progn 
(setq pline (cadar (ssnamex sset 0))) 
(setq pt (last (cadddr (last (ssnamex sset 0))))) 
;;------------------------------------------------ 
(setq obj (vlax-ename->vla-object pline)) 
     ;; чёрная дыра: 
     (if (and (eq "AcDbSpline" (vla-get-objectname obj))(eq :vlax-false (vla-get-isplanar obj))) 
       (progn 
    (alert "Не работает с некомпланарными сплайнами\n      Выход...") 
    (exit)(princ)) 
       ) 
     
      (setq pt   (pointoncurve pline pt) 
      leng   (distatparam pline (vlax-curve-getendparam pline)) 
      ) 
(while   (not 
     (and 
       (or 
         (initget 6) 
         (setq step (getreal "\nВведите шаг <100>: ")) 
         (if (not step) 
      (setq step 100.))) 
       (zerop (rem 100 step)))) 
   (alert (strcat "\nОстаток от деления 100 на шаг / " (rtos step 2 2) " не равен нулю, 
        \nВведен некорректный шаг")) 
   ) 


     (setq num (fix (/ leng step)) 
      ) 

     (setq div (fix (/ 100. step) 
          ) 
      ) 

     (setq mul (- leng 
        (* (setq lnum (fix (/ leng (* step div)))) (* step div)))) 

;;--------------------------------------------- 
(setq curh (getvar "textsize")) 
(setq curst (getvar "textstyle")) 
  (initget "Да Нет Yes No") 
(setq kw (getkword (strcat "\nИспользовать текущий стиль  текста " "\"" curst "\"" " ? " " [Да/Нет] <Да>: "))) 
(if (or (eq "No" kw)(eq "Нет" kw)) 
   
(if (not (eq "" 
(setq curst (getstring t "\nВведите имя нужного стиля текста: ")))) 
   
(add-textsyle adoc curst "simplex" nil nil 0.0 0.8);<-- измени имя шрифта здесь ---------------- 
  ) 
  ) 

(initget 6) 
(setq hgt (getreal (strcat "\nЗадайте высоту текста <" (rtos curh 2 1) ">: "))) 
(if (not hgt)(setq hgt curh)) 
(initget 6) 
(setq prec (getint (strcat "\nЗадайте число десятичных знаков <2>: "))) 
(if (not prec)(setq prec 2)) 
(while (setq pick (getpoint "\nУказать точку на кривой (Enter для завершения): ")) 

(setq plpt (vlax-curve-getclosestpointto pline pick)) 
(setq par (vlax-curve-getparamatpoint pline plpt)) 
(setq dist (vlax-curve-getdistatparam pline par)) 
(setq fd (vlax-curve-getfirstderiv pline par)) 
(setq ang (angtangent pline plpt) 
      degs (* 180 (/ ang pi))) 
   
  (setvar "osmode" 513) 

  (setq txtp plpt) 
  (setq da (right-ang (angtangent pline txtp))) 
  (setq txtp (polar txtp (+ da (/ pi 2))(/ hgt 2))) 

(princ (strcat "\nX : " (rtos (car plpt) 2 prec) 
          "\nY : " (rtos (cadr plpt) 2 prec) 
          "\nZ : " (rtos (caddr plpt) 2 prec) 
          "\nРасстояние : " (rtos dist 2 prec) 
          "\nУгол : " (rtos degs 2 prec))) 

   (setq txt (vla-addtext acsp 
      (if (< dist step)(strcat "+" (if (< (fix (- dist (* (fix (/ dist step)) step))) 10)"0" "")(rtos dist 2  prec)) 
  (strcat "+" 
     (if (< (fix (- dist (* (fix (/ dist step)) step))) 10)"0" "") 
     (rtos (- dist (* (fix (/ dist step)) step))2  prec))) 
      (vlax-3d-point txtp) 
      hgt) 
     ) 
  (vla-put-alignment txt acalignmentbottomcenter) 
   
  (vla-put-textalignmentpoint txt (vlax-3d-point txtp)) 
   
  (vla-put-insertionpoint txt (vla-get-textalignmentpoint txt)) 
   
  (vla-put-rotation txt da) 
  (vla-put-stylename txt curst) 


  (setvar "osmode" 513) 
  ) 
) 
      ) 

(vla-endundomark adoc) 
  (*error* nil) 
(princ) 
) 
(prompt "\n   ---   команда на выполнение \"DPICK2\" или \"dpick2\"  ---") 
(prin1) 
(or (vl-load-com) 
(princ) 
    ) 

;;----------------------------------  end of dpick2.lsp   --------------------------------;;

Последний раз редактировалось Кулик Алексей aka kpblc, 15.06.2015 в 11:41.
sosococo вне форума  
 
Непрочитано 15.06.2015, 11:42
#6
Кулик Алексей aka kpblc
Moderator

LISP, C# (ACAD 200[9,12,13,14])
 
Регистрация: 25.08.2003
С.-Петербург
Сообщений: 39,787


sosococo, существуют тэги [code][lisp]...[/lisp][/code]
__________________
Моя библиотека lisp-функций
---
Обращение ко мне - на "ты".
Все, что сказано - личное мнение.
Кулик Алексей aka kpblc вне форума  
 
Автор темы   Непрочитано 29.06.2015, 13:06
#7
sosococo

Генланист
 
Регистрация: 31.05.2015
г.Тюмень
Сообщений: 8


Доброго всем дня!
Хотелось бы получить консультацию у знатоков Лиспа, вопрос следующий :
Можно ли трансформировать код dpick.lsp таким образом, чтобы значение пикетажа не выводилось отдельным текстом, а вставлялось в значение атрибута выбранного блока. Эта задача подходит для проставления пикетажа в блоки дорожных знаков или блоки водопропускных труб. Может есть какай-нибудь подобный код с такой манипуляцией(для примера)?
sosococo вне форума  
 
Непрочитано 30.06.2015, 10:25
#8
Do$

AutoCAD/Civil3D LISP/C#
 
Регистрация: 15.08.2008
Санкт-Петербург
Сообщений: 1,702
Отправить сообщение для Do$ с помощью Skype™


Это даже проще, чем создавать текст. Смотрите функцию NENTSEL. С помощью нее выбираете атрибут и можете задать ему нужное текстовое содержание.
__________________
Толковый выбор приходит с опытом, а к нему приводит выбор бестолковый. (The Mechanic)
Do$ вне форума  
 
Автор темы   Непрочитано 27.01.2016, 13:36
#9
sosococo

Генланист
 
Регистрация: 31.05.2015
г.Тюмень
Сообщений: 8


Добрый день! Предыдущий раз не четко сформулировал задачу, может кто подскажет как выполнить вот такой алгоритм...
Алгоритм: 1. Все действия как в лиспе dpick до момента формирования значения пекетажа (например ПК5+45). 2. Выбираем нужный нам блок и в атрибут под названием "ПК" вставляется значение "ПК5+45". 3. Далее повторно выбираем точку на трассе для формирования значения пикетаж "n". 4.Выбираем нужный нам блок и в атрибут под названием "ПК" вставляется значение "n". и тд...
sosococo вне форума  
Ответ
Вернуться   Форум DWG.RU > Программное обеспечение > Программирование > LISP > Нужна помощь по изменению лиспа "Вставка пикетажа" в лисп "вставка плюсовой точки"

Размещение рекламы
Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск