Can use vlisp write a routine ? thanks

[Anonymous]

when drawing "line" ,can Enter "A" to  "select the target line" , specify a angle .

"You can if you want to make a line PARallel to an existing line, or PERPendicular to an existing line." 

I know ,can input Keyword “per” and "par" to do this ,bat can't specify a angle ! I think vlisp can do this , someone can write a routine ?

[Kent1Cooper]

I'm not sure I understand exactly what you're asking, but assuming some things:

If you want to draw a Line at a specified angle, and you know how long you want it to be, use the relative-displacement @length<angle approach:

Specify next point or [Undo]: @123.456<45

If you don't know the length but want to drag the length dynamically on-screen, and want it to be locked into a specified angle, you can use the < to specify that angle:

Specify next point or [Undo]: <45

and drag the length with the cursor.  The Line direction will be locked into the 45-degree [or the opposite 225-degree] direction, in the same way as it's locked into the four quadrant directions when Ortho is on.  [Such an angle designation will override Ortho.]

You can also specify the angle in that way, drag the cursor in the right direction, and then type in a length value, which is another way to do it when you know the length.

[Anonymous]

Thanks ,kent1cooper, thank you for reply ,but That's not what I mean.

I know how to draw a line with angle (@length<angle ).

I mean :

when drawing line , can pick  another line(target line)  , Enter the angle ,This angle  between the line and the reference line . if Enter the angel  is: 0 ,so this line PARallel the target line ,  if Enter the angle is : 90  , so this line PERPendicular the target line.   Of course also can enter the other Angle.

[Kent1Cooper]

---

@Anonymous wrote:

.... 

when drawing line , can pick  another line(target line)  , Enter the angle ,This angle  between the line and the reference line .....

---

Isn't that exactly what your video demonstration of a "ZWMIntelligentLine" command shows?  If so, what need is there for another routine?  If not, how does what you want to do differ from what is shown in the video?

[Anonymous]

Hi Mr. kent

I need this routine as "ZWMIntelligentLine" , This CAD is not Autocad , only a Trial software. Thanks !

[marko_ribar · Accepted solution]

Maybe something like this :

(defun c:alin ( / *adoc* pt opt ptt esel ent pent ang difang nang ptw )

  (vl-load-com)
  (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))

  (setq pt (getpoint "\nSpecify first point : "))
  (while
    (and
      (setq opt (cons pt opt))
      (not (initget 128))
      (setq ptt (getpoint pt "\nSpecify next point or - F8 for orthomode [Angle line/Undo] : "))
      (setq opt (cons ptt opt))
    )
    (cond
      ( (eq (type ptt) 'list)
        (vla-startundomark *adoc*)
        (command "_.LINE" "_non" pt "_non" ptt "")
        (setvar 'orthomode 0)
        (setq pt ptt)
        (vla-endundomark *adoc*)
      )
      ( (or (wcmatch ptt "a*") (wcmatch ptt "A*"))
        (vla-startundomark *adoc*)
        (setq esel (entsel "\nPick target curve to obtain its angle"))
        (setq ent (car esel))
        (setq pent (vlax-curve-getclosestpointto ent (cadr esel)))
        (setq ang (angle '(0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent pent))))
        (setq difang (cvunit (getreal "\nSpecify angle to picked curve in decimal degrees : ") "degree" "radian"))
        (setq nang (cvunit (- ang difang) "radian" "degree"))
        (setq ptw (trans pt 1 0))
        (command "_.UCS" "_W")
        (command "_.UCS" "_Z" nang)
        (setvar 'orthomode 1)
        (command "_.LINE" "_non" (trans ptw 0 1) "\\")
        (while (> (getvar 'cmdactive) 0) (command ""))
        (setvar 'orthomode 0)
        (setq ptw (trans (getvar 'lastpoint) 1 0))
        (command "_.UCS" "_P")
        (command "_.UCS" "_P")
        (setq pt (trans ptw 0 1))
        (vla-endundomark *adoc*)
      )
      ( (or (wcmatch ptt "u*") (wcmatch ptt "U*"))
        (command "_.UNDO" "")
        (if (eq (length opt) 2) (setq pt (cadr opt)) (progn (if (equal (cadr opt) (cadddr opt) 1e-8) (setq opt (cddddr opt)) (setq opt (cddr opt))) (setq pt (cadr opt))))
      )
    )
  )
  (princ)
)

 HTH, M.R.

[marko_ribar · Accepted solution]

Update, now it creates LWPOLYLINE... If you want only lines, just explode upon routine execution... And my previous code had some lacks, I suggest that you use this new one...

(defun c:alin ( / *adoc* pea pt opt ptt el esel ent pent ang difang nang ptw ss )

  (vl-load-com)
  (setq *adoc* (vla-get-activedocument (vlax-get-acad-object)))

  (setq pt (getpoint "\nSpecify first point : "))
  (while
    (and
      pt
      (setq opt (cons pt opt))
      (not (initget 128))
      (setq ptt (getpoint pt "\nSpecify next point or - F8 for orthomode [Angle line/Undo] : "))
      (setq opt (cons ptt opt))
    )
    (cond
      ( (eq (type ptt) 'list)
        (vla-startundomark *adoc*)
        (command "_.LINE" "_non" pt "_non" ptt "")
        (setq el (cons (entlast) el))
        (setvar 'orthomode 0)
        (setq pt ptt)
        (vla-endundomark *adoc*)
      )
      ( (or (wcmatch ptt "a*") (wcmatch ptt "A*"))
        (vla-startundomark *adoc*)
        (setq esel (entsel "\nPick target curve to obtain its angle"))
        (setq ent (car esel))
        (setq pent (vlax-curve-getclosestpointto ent (cadr esel)))
        (setq ang (angle '(0.0 0.0) (vlax-curve-getfirstderiv ent (vlax-curve-getparamatpoint ent pent))))
        (setq difang (cvunit (getreal "\nSpecify angle to picked curve in decimal degrees : ") "degree" "radian"))
        (setq nang (cvunit (- ang difang) "radian" "degree"))
        (setq ptw (trans pt 1 0))
        (command "_.UCS" "_W")
        (command "_.UCS" "_Z" nang)
        (setvar 'orthomode 1)
        (command "_.LINE" "_non" (trans ptw 0 1) "\\")
        (while (> (getvar 'cmdactive) 0) (command ""))
        (setq el (cons (entlast) el))
        (setvar 'orthomode 0)
        (setq ptw (trans (getvar 'lastpoint) 1 0))
        (command "_.UCS" "_P")
        (command "_.UCS" "_P")
        (setq pt (trans ptw 0 1))
        (vla-endundomark *adoc*)
      )
      ( (or (wcmatch ptt "u*") (wcmatch ptt "U*"))
        (if (eq (length opt) 2) 
          (setq pt nil)
          (progn 
            (if (equal (cadr opt) (cadddr opt) 1e-8) 
              (setq opt (cddddr opt)) 
              (setq opt (cddr opt))
            )
            (if (null opt)
              (setq pt nil)
              (progn
                (command "_.UNDO" "") 
                (setq el (cdr el)) 
                (setq pt (cadr opt))
              )
            )
          )
        )
      )
    )
  )
  (if (not (null el))
    (progn
      (setq ss (ssadd))
      (foreach l el
        (ssadd l ss)
      )
      (setq pea (getvar 'peditaccept))
      (setvar 'peditaccept 1)
      (command "_.PEDIT" "_M" ss "" "_J")
      (while (> (getvar 'cmdactive) 0) (command ""))
      (setvar 'peditaccept pea)
    )
  )
  (princ)
)

 HTH, M.R.

[marko_ribar]

One more remark...

Look here :

http://www.cadtutor.net/forum/showthread.php?90298-smart-line/page4&p=#35

M.R.

[Anonymous]

Very very very thank you ! Marko .I'm very honored and grateful!!  Best wishes for a wonderful new year!