[Mikhail]

Добрый день.
Вот что то стал часто делать такую операцию- чертить отрезки от разнх точек к оному и тому же отрезку, конечная привязка к отрезку- перпендикуляр.
Т.е. если у кого то есть или может не трудно, что то типа.
- быбрал отрезок
- и указываю точки, из них строятся отрезки к выбранному отрезку с привязкой перпендикуляр.
Спасибо)

На первое время могу предложить такой код

Код:

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

(defun c:perpline (/ ss ln1 ln1-10 ln1-11 an2 t3 t4)
    (princ "\nУкажите линию: ")
    (if (setq ss (ssget ":S" '((0 . "line"))))
        (progn
            (setq
                ln1    (entget (ssname ss 0)) ; ñïèñîê ïðèìèòèâà
                ln1-10 (cdr (assoc 10 ln1)) ;ïåðâàÿ òî÷êà 
                ln1-11 (cdr (assoc 11 ln1)) ;âòîðàÿ òî÷êà
                an2    (+ (angle ln1-10 ln1-11) (/ pi 2))
            ) ;_ setq

            (while (setq t3 (getpoint "\nУкажите точку:"));òðåòüÿ òî÷êà
                (if (setq t4 (inters ln1-10 ;÷åòâåðòàÿ òî÷êà
                                     ln1-11
                                     t3
                                     (polar t3 an2 1.0)
                                     nil
                             ) ;_ inters
                    ) ;_ setq
                    (command "_.line" t3 t4 "")
                ) ;_ if
            ) ;_ while
        ) ;_ progn
    ) ;_ if
    (princ)
) ;_ defun

Дубль два:

Код:

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

(defun c:perpline (/ ss ln1 ln1-10 ln1-11 an2 t3 t4)
  (princ "\nSelect line: ")
  (if (setq ss (ssget ":S" '((0 . "line"))))
    (progn
      (setq
        ln1    (entget (ssname ss 0)) 
        ln1-10 (cdr (assoc 10 ln1)) 
        ln1-11 (cdr (assoc 11 ln1)) 
        an2    (+ (angle ln1-10 ln1-11) (/ pi 2))
      ) ;_ setq

      (while (setq t3 (getpoint "\nSpecify point:"))
        (if (setq t4 (inters ln1-10 
                             ln1-11
                             t3
                             (polar t3 an2 1.0)
                             nil
                     ) ;_ inters
            ) ;_ setq
          (command "_.line" t3 t4 "")
        ) ;_ if
      ) ;_ while
    ) ;_ progn
  ) ;_ if
  (princ)
) ;_ defun

[Mikhail]

СПАСИБО)
Извините за лень) Никак ЛИСП не собратся и не выучить.

[Эдуард]

Или так:

Код:

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

(vl-load-com)
(defun C:per-line	(/ baze-line start_point list_start_point)
  (if
    (and
      (setq baze-line (car (entsel "\nSelect line:")))
      (equal (cdr (assoc 0 (entget baze-line))) "LINE")
    ) ;_ end of and
     (progn
       (setq baze-line (vlax-ename->vla-object baze-line))
       (while (setq start_point (getpoint "\nPick Point:"))
	 (setq list_start_point (cons start_point list_start_point))
       ) ;_ end of while
       (if list_start_point
	 (mapcar
	   (function
	     (lambda (x)
	       (vla-addline
		 (vla-ObjectIDToObject
		   (vla-get-activedocument (vlax-get-acad-object))
		   (vla-get-ownerid baze-line)
		 ) ;_ end of vla-ObjectIDToObject
		 (vlax-3d-point x)
		 (vlax-3d-point
		   (vlax-curve-getClosestPointTo baze-line x :vlax-true)
		 ) ;_ end of vlax-3d-point
	       ) ;_ end of vla-addline
	     ) ;_ end of lambda
	   ) ;_ end of function
	   list_start_point
	 ) ;_ end of mapcar
       ) ;_ end of if
     ) ;_ end of progn
  ) ;_ end of if
  (princ)
) ;_ end of defun

[Mikhail]

А в чем разница если не секрет? Там на Лиспе а это VBA? А по функциональности?
Спасибо.

Что бы не стыдно было исправлю недостатки:

Код:

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

(defun c:perpline (/ ss ln1 ln1-10 ln1-11 an2 t3 t4)
  (princ "\nSelect line: ")
  (if (setq ss (ssget ":S" '((0 . "line"))))
    (progn
      (setq
        ln1    (entget (ssname ss 0))
        ln1-10 (cdr (assoc 10 ln1))
        ln1-11 (cdr (assoc 11 ln1))
        an2    (+ (angle ln1-10 ln1-11) (/ pi 2))
      ) ;_ setq
      (while (setq t3 (getpoint "\nSpecify point:"))
        (if (setq t3 (trans t3 1 0)
                  t4 (inters ln1-10
                             ln1-11
                             t3
                             (polar t3 an2 1.0)
                             nil
                     ) ;_ inters
            ) ;_ setq
           (entmake (list '(0 . "line")
                         (cons 10 t3)
                         (cons 11 t4)
                   ) ;_ list
          ) ;_ entmake
        ) ;_ if
      ) ;_ while
    ) ;_ progn
  ) ;_ if
  (princ)
) ;_ defun

[Mikhail]

вариант AY нравится больше так как там линии рисуются динамически, т.е. непосредственно после указания точки.
А вот еще такой общий вопрос. Можно ли сделать выбор линии как допустим в команде TRIM? Там можно выбирать даже примитивы из блока.

[Ahntv]

Уважаемые LISP-инженеры и dwg.ru-форумчане.
Тема старая, но очень актуальная.
Как исправить lisp чтобы можно выбирать не только отрезок, но и блок или прямоугольник, чтобы отрезки рисовались к нему.
Заранее вам благодарен.