« previous next »
Pages: [1] |   Go Down

Author Topic: Dynamic Perpendicular  (Read 1809 times)

0 Members and 1 Guest are viewing this topic.

mariolino0099

  • Newt
  • Posts: 25
Dynamic Perpendicular
« on: February 13, 2023, 08:36:52 AM »
hello everyone, i found the code listed below, unfortunately i have a problem, although i have enabled osnap it is not able to complete the command correctly by going for example to get an "endpoint". Also the command stops if during the command I activate or deactivate with F3 the osnap.
I thank those who can help me.

Code: [Select]
(defun c:lpr ( / e g p q )
  (LM:grsnap:snapfunction)
    (while
        (not
            (progn (setvar 'errno 0) (setq e (entsel))
                (cond
                    (   (= 7 (getvar 'errno))
                        (prompt "\nMissed, try again.")
                    )
                    (   (null e))
                    (   (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getclosestpointto e))
                        (prompt "\nInvalid object selected.")
                    )
                    (
             (setq osf (LM:grsnap:snapfunction)osm (getvar 'osmode))

             (setq e (car e))
                        (while (= 5 (car (setq g (grread t 13 0))))
                            (redraw)(osf (cadr g) osm)
                            (if (setq q (vlax-curve-getclosestpointto e (trans (cadr g) 1 0) t))
                                (grdraw (cadr g) (trans q 0 1) 1)
                            )
                        )
                        (if (= 3 (car g))
                            (progn
                                (entmake
                                    (list
                                       '(0 . "LINE")
                                        (cons 10 (setq p (trans (cadr g) 1 0)))
                                        (cons 11 (setq q (vlax-curve-getclosestpointto e (trans (cadr g) 1 0) t)))
                        (cons 62 2)
                                    )
                                )
                  (entmakex (list (cons 0 "TEXT")
                                (cons 10 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p q)))
                    (cons 11 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p q)))
                                (cons 1 (rtos (distance p q) 2 2))
                    (cons 50 (LM:readable(angle p q)))
                                (cons 62 1)(cons 40 30)(cons 41 0.7)(cons 72 1)(cons 73 1)
                    ))
                                (princ "\nLine endpoints: ") (princ p) (princ " | ") (princ q)
                                (princ "\nLength: ") (princ (distance p q))
                            )
                            t
                        )
                    )
                )
            )
        )
    )
    (redraw) (princ)
)

(defun LM:readable ( a )
    (   (lambda ( a )
            (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
                (LM:readable (+ a pi))
                a
            )
        )
        (rem (+ a pi pi) (+ pi pi))
    )
)


;; Object Snap for grread: Snap Function - Lee Mac
;; Returns: [fun] A function requiring two arguments:
;; p - [lst] UCS Point to be snapped
;; o - [int] Object Snap bit code
;; The returned function returns either the snapped point (displaying an appropriate snap symbol)
;; or the supplied point if the snap failed for the given Object Snap bit code.
(defun LM:grsnap:snapfunction ( )
(eval
(list 'lambda '( p o / q )
(list 'if '(zerop (logand 16384 o))
(list 'if
'(setq q
(cdar
(vl-sort
(vl-remove-if 'null
(mapcar
(function
(lambda ( a / b )
(if (and (= (car a) (logand (car a) o)) (setq b (osnap p (cdr a))))
(list (distance p b) b (car a))
)
)
)
'(
(0001 . "_end")
(0002 . "_mid")
(0004 . "_cen")
(0008 . "_nod")
(0016 . "_qua")
(0032 . "_int")
(0064 . "_ins")
(0128 . "_per")
(0256 . "_tan")
(0512 . "_nea")
(2048 . "_app")
(8192 . "_par")
)
)
)
'(lambda ( a b ) (< (car a) (car b)))
)
)
)
(list 'LM:grsnap:displaysnap '(car q)
(list 'cdr
(list 'assoc '(cadr q)
(list 'quote
(LM:grsnap:snapsymbols
(atoi (cond ((getenv "AutoSnapSize")) ("5")))
)
)
)
)
(LM:OLE->ACI
(if (= 1 (getvar 'cvport))
(atoi (cond ((getenv "Layout AutoSnap Color")) ("117761")))
(atoi (cond ((getenv "Model AutoSnap Color")) ("104193")))
)
)
)
)
)
'(cond ((car q)) (p))
)
)
)
;; Object Snap for grread: Display Snap - Lee Mac
;; pnt - [lst] UCS point at which to display the symbol
;; lst - [lst] grvecs vector list
;; col - [int] ACI colour for displayed symbol
;; Returns nil
(defun LM:grsnap:displaysnap ( pnt lst col / scl )
(setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
pnt (trans pnt 1 2)
)
(grvecs (cons col lst)
(list
(list scl 0.0 0.0 (car pnt))
(list 0.0 scl 0.0 (cadr pnt))
(list 0.0 0.0 scl 0.0)
'(0.0 0.0 0.0 1.0)
)
)
)
;; Object Snap for grread: Snap Symbols - Lee Mac
;; p - [int] Size of snap symbol in pixels
;; Returns: [lst] List of vector lists describing each Object Snap symbol
(defun LM:grsnap:snapsymbols ( p / -p -q -r a c i l q r )
(setq -p (- p) q (1+ p)
-q (- q) r (+ 2 p)
-r (- r) i (/ pi 6.0)
a 0.0
)
(repeat 12
(setq l (cons (list (* r (cos a)) (* r (sin a))) l)
a (- a i)
)
)
(setq c (apply 'append (mapcar 'list (cons (last l) l) l)))
(list
(list 1
(list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
(list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
)
(list 2
(list -r -q) (list 0 r) (list 0 r) (list r -q)
(list -p -p) (list p -p) (list p -p) (list 0 p) (list 0 p) (list -p -p)
(list -q -q) (list q -q) (list q -q) (list 0 q) (list 0 q) (list -q -q)
)
(cons 4 c)
(vl-list* 8 (list -r -r) (list r r) (list r -r) (list -r r) c)
(list 16
(list p 0) (list 0 p) (list 0 p) (list -p 0) (list -p 0) (list 0 -p) (list 0 -p) (list p 0)
(list q 0) (list 0 q) (list 0 q) (list -q 0) (list -q 0) (list 0 -q) (list 0 -q) (list q 0)
(list r 0) (list 0 r) (list 0 r) (list -r 0) (list -r 0) (list 0 -r) (list 0 -r) (list r 0)
)
(list 32
(list r r) (list -r -r) (list r q) (list -q -r) (list q r) (list -r -q)
(list -r r) (list r -r) (list -q r) (list r -q) (list -r q) (list q -r)
)
(list 64
'( 0 1) (list 0 p) (list 0 p) (list -p p) (list -p p) (list -p -1) (list -p -1) '( 0 -1)
'( 0 -1) (list 0 -p) (list 0 -p) (list p -p) (list p -p) (list p 1) (list p 1) '( 0 1)
'( 1 2) (list 1 q) (list 1 q) (list -q q) (list -q q) (list -q -2) (list -q -2) '(-1 -2)
'(-1 -2) (list -1 -q) (list -1 -q) (list q -q) (list q -q) (list q 2) (list q 2) '( 1 2)
)
(list 128
(list (1+ -p) 0) '(0 0) '(0 0) (list 0 (1+ -p))
(list (1+ -p) 1) '(1 1) '(1 1) (list 1 (1+ -p))
(list -p q) (list -p -p) (list -p -p) (list q -p)
(list -q q) (list -q -q) (list -q -q) (list q -q)
)
(vl-list* 256 (list -r r) (list r r) (list -r (1+ r)) (list r (1+ r)) c)
(list 512
(list -p -p) (list p -p) (list -p p) (list p p) (list -q -q) (list q -q)
(list q -q) (list -q q) (list -q q) (list q q) (list q q) (list -q -q)
)
(list 2048
(list -p -p) (list p p) (list -p p) (list p -p)
(list (+ p 05) -p) (list (+ p 06) -p) (list (+ p 05) -q) (list (+ p 06) -q)
(list (+ p 09) -p) (list (+ p 10) -p) (list (+ p 09) -q) (list (+ p 10) -q)
(list (+ p 13) -p) (list (+ p 14) -p) (list (+ p 13) -q) (list (+ p 14) -q)
(list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
(list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
)
(list 8192 (list r 1) (list -r -q) (list r 0) (list -r -r) (list r q) (list -r -1) (list r r) (list -r 0))
)
)
;; Object Snap for grread: Parse Point - Lee Mac
;; bpt - [lst] Basepoint for relative point input, e.g. @5,5
;; str - [str] String representing point input
;; Returns: [lst] Point represented by the given string, else nil
(defun LM:grsnap:parsepoint ( bpt str / str->lst lst )

(defun str->lst ( str / pos )
(if (setq pos (vl-string-position 44 str))
(cons (substr str 1 pos) (str->lst (substr str (+ pos 2))))
(list str)
)
)
(if (wcmatch str "`@*")
(setq str (substr str 2))
(setq bpt '(0.0 0.0 0.0))
)
(if
(and
(setq lst (mapcar 'distof (str->lst str)))
(vl-every 'numberp lst)
(< 1 (length lst) 4)
)
(mapcar '+ bpt lst)
)
)
;; Object Snap for grread: Snap Mode - Lee Mac
;; str - [str] Object Snap modifier
;; Returns: [int] Object Snap bit code for the given modifier, else nil
(defun LM:grsnap:snapmode ( str )
(vl-some
(function
(lambda ( x )
(if (wcmatch (car x) (strcat (strcase str t) "*"))
(progn
(princ (cadr x)) (caddr x)
)
)
)
)
'(
("endpoint" " of " 00001)
("midpoint" " of " 00002)
("center" " of " 00004)
("node" " of " 00008)
("quadrant" " of " 00016)
("intersection" " of " 00032)
("insert" " of " 00064)
("perpendicular" " to " 00128)
("tangent" " to " 00256)
("nearest" " to " 00512)
("appint" " of " 02048)
("parallel" " to " 08192)
("none" "" 16384)
)
)
)
;; OLE -> ACI - Lee Mac
;; Args: c - [int] OLE Colour
(defun LM:OLE->ACI ( c )
(apply 'LM:RGB->ACI (LM:OLE->RGB c))
)
;; OLE -> RGB - Lee Mac
;; Args: c - [int] OLE Colour
(defun LM:OLE->RGB ( c )
(mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))
)
;; RGB -> ACI - Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values
(defun LM:RGB->ACI ( r g b / c o )
(if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
(progn
(setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
(vlax-release-object o)
(if (vl-catch-all-error-p c)
(prompt (strcat "\nError: " (vl-catch-all-error-message c)))
c
)
)
)
)
;; Application Object - Lee Mac
;; Returns the VLA Application Object
(defun LM:acapp nil
(eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
(LM:acapp)
)
;;----------------------------------------------------------------------;;
Logged

mariolino0099

  • Newt
  • Posts: 25
Re: Dynamic Perpendicular
« Reply #1 on: February 16, 2023, 07:41:31 AM »
no help :-( ?
Logged

MSTG007

  • Gator
  • Posts: 2601
  • I can't remeber what I already asked! I need help!
Re: Dynamic Perpendicular
« Reply #2 on: February 16, 2023, 08:17:44 AM »
I wanted to say great job on this. Very cool idea with how it works.
Logged
Civil3D 2020

hmspe

  • Bull Frog
  • Posts: 362
Re: Dynamic Perpendicular
« Reply #3 on: February 16, 2023, 09:30:04 AM »
Logged
"Science is the belief in the ignorance of experts." - Richard Feynman

mariolino0099

  • Newt
  • Posts: 25
Re: Dynamic Perpendicular
« Reply #4 on: February 16, 2023, 09:32:44 AM »
it works very well except for the things I reported, unfortunately I don't have the skills to correct it.....
Toward the bottom I saw Lee Mac's signature for some parts of the code.....
I found this lisp application yesterday
http://www.lee-mac.com/dynamicoffset.html
which would be virtually identical if only you could keep the cyan-colored construction line that is created during offset operations.....
Unfortunately, again, I don't know how to restrict the code to keep only the offset....

Logged

BIGAL

  • Swamp Rat
  • Posts: 1411
  • 40 + years of using Autocad
Re: Dynamic Perpendicular
« Reply #5 on: February 16, 2023, 05:44:32 PM »
Do you need it to be dynamic ? There is lots of code for sq off line and a point etc. Explain more what your trying to do image or dwg.
Logged
A man who never made a mistake never made anything

dexus

  • Bull Frog
  • Posts: 207
Re: Dynamic Perpendicular
« Reply #6 on: February 17, 2023, 03:38:08 AM »
Quote from: mariolino0099 on February 13, 2023, 08:36:52 AM
hello everyone, i found the code listed below, unfortunately i have a problem, although i have enabled osnap it is not able to complete the command correctly by going for example to get an "endpoint". Also the command stops if during the command I activate or deactivate with F3 the osnap.
I thank those who can help me.

Code: [Select]
(defun c:lpr ( / e g p q )
  (LM:grsnap:snapfunction)
    (while
        (not
            (progn (setvar 'errno 0) (setq e (entsel))
                (cond
                    (   (= 7 (getvar 'errno))
                        (prompt "\nMissed, try again.")
                    )
                    (   (null e))
                    (   (vl-catch-all-error-p (vl-catch-all-apply 'vlax-curve-getclosestpointto e))
                        (prompt "\nInvalid object selected.")
                    )
                    (
             (setq osf (LM:grsnap:snapfunction)osm (getvar 'osmode))

             (setq e (car e))
                        (while (= 5 (car (setq g (grread t 13 0))))
                            (redraw)(osf (cadr g) osm)
                            (if (setq q (vlax-curve-getclosestpointto e (trans (cadr g) 1 0) t))
                                (grdraw (cadr g) (trans q 0 1) 1)
                            )
                        )
                        (if (= 3 (car g))
                            (progn
                                (entmake
                                    (list
                                       '(0 . "LINE")
                                        (cons 10 (setq p (trans (cadr g) 1 0)))
                                        (cons 11 (setq q (vlax-curve-getclosestpointto e (trans (cadr g) 1 0) t)))
                        (cons 62 2)
                                    )
                                )
                  (entmakex (list (cons 0 "TEXT")
                                (cons 10 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p q)))
                    (cons 11 (mapcar '* '(0.5 0.5 0.5) (mapcar '+ p q)))
                                (cons 1 (rtos (distance p q) 2 2))
                    (cons 50 (LM:readable(angle p q)))
                                (cons 62 1)(cons 40 30)(cons 41 0.7)(cons 72 1)(cons 73 1)
                    ))
                                (princ "\nLine endpoints: ") (princ p) (princ " | ") (princ q)
                                (princ "\nLength: ") (princ (distance p q))
                            )
                            t
                        )
                    )
                )
            )
        )
    )
    (redraw) (princ)
)

(defun LM:readable ( a )
    (   (lambda ( a )
            (if (and (< (* pi 0.5) a) (<= a (* pi 1.5)))
                (LM:readable (+ a pi))
                a
            )
        )
        (rem (+ a pi pi) (+ pi pi))
    )
)


;; Object Snap for grread: Snap Function - Lee Mac
;; Returns: [fun] A function requiring two arguments:
;; p - [lst] UCS Point to be snapped
;; o - [int] Object Snap bit code
;; The returned function returns either the snapped point (displaying an appropriate snap symbol)
;; or the supplied point if the snap failed for the given Object Snap bit code.
(defun LM:grsnap:snapfunction ( )
(eval
(list 'lambda '( p o / q )
(list 'if '(zerop (logand 16384 o))
(list 'if
'(setq q
(cdar
(vl-sort
(vl-remove-if 'null
(mapcar
(function
(lambda ( a / b )
(if (and (= (car a) (logand (car a) o)) (setq b (osnap p (cdr a))))
(list (distance p b) b (car a))
)
)
)
'(
(0001 . "_end")
(0002 . "_mid")
(0004 . "_cen")
(0008 . "_nod")
(0016 . "_qua")
(0032 . "_int")
(0064 . "_ins")
(0128 . "_per")
(0256 . "_tan")
(0512 . "_nea")
(2048 . "_app")
(8192 . "_par")
)
)
)
'(lambda ( a b ) (< (car a) (car b)))
)
)
)
(list 'LM:grsnap:displaysnap '(car q)
(list 'cdr
(list 'assoc '(cadr q)
(list 'quote
(LM:grsnap:snapsymbols
(atoi (cond ((getenv "AutoSnapSize")) ("5")))
)
)
)
)
(LM:OLE->ACI
(if (= 1 (getvar 'cvport))
(atoi (cond ((getenv "Layout AutoSnap Color")) ("117761")))
(atoi (cond ((getenv "Model AutoSnap Color")) ("104193")))
)
)
)
)
)
'(cond ((car q)) (p))
)
)
)
;; Object Snap for grread: Display Snap - Lee Mac
;; pnt - [lst] UCS point at which to display the symbol
;; lst - [lst] grvecs vector list
;; col - [int] ACI colour for displayed symbol
;; Returns nil
(defun LM:grsnap:displaysnap ( pnt lst col / scl )
(setq scl (/ (getvar 'viewsize) (cadr (getvar 'screensize)))
pnt (trans pnt 1 2)
)
(grvecs (cons col lst)
(list
(list scl 0.0 0.0 (car pnt))
(list 0.0 scl 0.0 (cadr pnt))
(list 0.0 0.0 scl 0.0)
'(0.0 0.0 0.0 1.0)
)
)
)
;; Object Snap for grread: Snap Symbols - Lee Mac
;; p - [int] Size of snap symbol in pixels
;; Returns: [lst] List of vector lists describing each Object Snap symbol
(defun LM:grsnap:snapsymbols ( p / -p -q -r a c i l q r )
(setq -p (- p) q (1+ p)
-q (- q) r (+ 2 p)
-r (- r) i (/ pi 6.0)
a 0.0
)
(repeat 12
(setq l (cons (list (* r (cos a)) (* r (sin a))) l)
a (- a i)
)
)
(setq c (apply 'append (mapcar 'list (cons (last l) l) l)))
(list
(list 1
(list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
(list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
)
(list 2
(list -r -q) (list 0 r) (list 0 r) (list r -q)
(list -p -p) (list p -p) (list p -p) (list 0 p) (list 0 p) (list -p -p)
(list -q -q) (list q -q) (list q -q) (list 0 q) (list 0 q) (list -q -q)
)
(cons 4 c)
(vl-list* 8 (list -r -r) (list r r) (list r -r) (list -r r) c)
(list 16
(list p 0) (list 0 p) (list 0 p) (list -p 0) (list -p 0) (list 0 -p) (list 0 -p) (list p 0)
(list q 0) (list 0 q) (list 0 q) (list -q 0) (list -q 0) (list 0 -q) (list 0 -q) (list q 0)
(list r 0) (list 0 r) (list 0 r) (list -r 0) (list -r 0) (list 0 -r) (list 0 -r) (list r 0)
)
(list 32
(list r r) (list -r -r) (list r q) (list -q -r) (list q r) (list -r -q)
(list -r r) (list r -r) (list -q r) (list r -q) (list -r q) (list q -r)
)
(list 64
'( 0 1) (list 0 p) (list 0 p) (list -p p) (list -p p) (list -p -1) (list -p -1) '( 0 -1)
'( 0 -1) (list 0 -p) (list 0 -p) (list p -p) (list p -p) (list p 1) (list p 1) '( 0 1)
'( 1 2) (list 1 q) (list 1 q) (list -q q) (list -q q) (list -q -2) (list -q -2) '(-1 -2)
'(-1 -2) (list -1 -q) (list -1 -q) (list q -q) (list q -q) (list q 2) (list q 2) '( 1 2)
)
(list 128
(list (1+ -p) 0) '(0 0) '(0 0) (list 0 (1+ -p))
(list (1+ -p) 1) '(1 1) '(1 1) (list 1 (1+ -p))
(list -p q) (list -p -p) (list -p -p) (list q -p)
(list -q q) (list -q -q) (list -q -q) (list q -q)
)
(vl-list* 256 (list -r r) (list r r) (list -r (1+ r)) (list r (1+ r)) c)
(list 512
(list -p -p) (list p -p) (list -p p) (list p p) (list -q -q) (list q -q)
(list q -q) (list -q q) (list -q q) (list q q) (list q q) (list -q -q)
)
(list 2048
(list -p -p) (list p p) (list -p p) (list p -p)
(list (+ p 05) -p) (list (+ p 06) -p) (list (+ p 05) -q) (list (+ p 06) -q)
(list (+ p 09) -p) (list (+ p 10) -p) (list (+ p 09) -q) (list (+ p 10) -q)
(list (+ p 13) -p) (list (+ p 14) -p) (list (+ p 13) -q) (list (+ p 14) -q)
(list -p -p) (list p -p) (list p -p) (list p p) (list p p) (list -p p) (list -p p) (list -p -p)
(list -q -q) (list q -q) (list q -q) (list q q) (list q q) (list -q q) (list -q q) (list -q -q)
)
(list 8192 (list r 1) (list -r -q) (list r 0) (list -r -r) (list r q) (list -r -1) (list r r) (list -r 0))
)
)
;; Object Snap for grread: Parse Point - Lee Mac
;; bpt - [lst] Basepoint for relative point input, e.g. @5,5
;; str - [str] String representing point input
;; Returns: [lst] Point represented by the given string, else nil
(defun LM:grsnap:parsepoint ( bpt str / str->lst lst )

(defun str->lst ( str / pos )
(if (setq pos (vl-string-position 44 str))
(cons (substr str 1 pos) (str->lst (substr str (+ pos 2))))
(list str)
)
)
(if (wcmatch str "`@*")
(setq str (substr str 2))
(setq bpt '(0.0 0.0 0.0))
)
(if
(and
(setq lst (mapcar 'distof (str->lst str)))
(vl-every 'numberp lst)
(< 1 (length lst) 4)
)
(mapcar '+ bpt lst)
)
)
;; Object Snap for grread: Snap Mode - Lee Mac
;; str - [str] Object Snap modifier
;; Returns: [int] Object Snap bit code for the given modifier, else nil
(defun LM:grsnap:snapmode ( str )
(vl-some
(function
(lambda ( x )
(if (wcmatch (car x) (strcat (strcase str t) "*"))
(progn
(princ (cadr x)) (caddr x)
)
)
)
)
'(
("endpoint" " of " 00001)
("midpoint" " of " 00002)
("center" " of " 00004)
("node" " of " 00008)
("quadrant" " of " 00016)
("intersection" " of " 00032)
("insert" " of " 00064)
("perpendicular" " to " 00128)
("tangent" " to " 00256)
("nearest" " to " 00512)
("appint" " of " 02048)
("parallel" " to " 08192)
("none" "" 16384)
)
)
)
;; OLE -> ACI - Lee Mac
;; Args: c - [int] OLE Colour
(defun LM:OLE->ACI ( c )
(apply 'LM:RGB->ACI (LM:OLE->RGB c))
)
;; OLE -> RGB - Lee Mac
;; Args: c - [int] OLE Colour
(defun LM:OLE->RGB ( c )
(mapcar '(lambda ( x ) (lsh (lsh (fix c) x) -24)) '(24 16 8))
)
;; RGB -> ACI - Lee Mac
;; Args: r,g,b - [int] Red, Green, Blue values
(defun LM:RGB->ACI ( r g b / c o )
(if (setq o (vla-getinterfaceobject (LM:acapp) (strcat "autocad.accmcolor." (substr (getvar 'acadver) 1 2))))
(progn
(setq c (vl-catch-all-apply '(lambda ( ) (vla-setrgb o r g b) (vla-get-colorindex o))))
(vlax-release-object o)
(if (vl-catch-all-error-p c)
(prompt (strcat "\nError: " (vl-catch-all-error-message c)))
c
)
)
)
)
;; Application Object - Lee Mac
;; Returns the VLA Application Object
(defun LM:acapp nil
(eval (list 'defun 'LM:acapp 'nil (vlax-get-acad-object)))
(LM:acapp)
)
;;----------------------------------------------------------------------;;
The osf function returns the point that is snapped, so you want to use the return as the chosen point.
Logged

mariolino0099

  • Newt
  • Posts: 25
Re: Dynamic Perpendicular
« Reply #7 on: February 17, 2023, 05:25:50 AM »
i think the code part is this:

                                       '(0 . "LINE")
                                        (cons 10 (setq p (trans (cadr g) 1 0)))
                                        (cons 11 (setq q (vlax-curve-getclosestpointto e (trans (cadr g) 1 0) t)))

however I can't use osf to extract coordinates if a snap was found....
Logged

mariolino0099

  • Newt
  • Posts: 25
Re: Dynamic Perpendicular
« Reply #8 on: February 17, 2023, 05:36:06 AM »
in the attached image you can see the polyline object to which I have to make a perpendicular line, since it consists of hundreds of small segments it is not easy to locate the nearest segment, with LPR I can first select the object and also see well where the perpendicular starts.


Logged

dexus

  • Bull Frog
  • Posts: 207
Re: Dynamic Perpendicular
« Reply #9 on: February 17, 2023, 06:36:10 AM »
Quote from: mariolino0099 on February 17, 2023, 05:25:50 AM
i think the code part is this:

                                       '(0 . "LINE")
                                        (cons 10 (setq p (trans (cadr g) 1 0)))
                                        (cons 11 (setq q (vlax-curve-getclosestpointto e (trans (cadr g) 1 0) t)))

however I can't use osf to extract coordinates if a snap was found....
Give this a try.
Code - Auto/Visual Lisp: [Select]
  1.   (setq p (trans (osf (cadr g) osm) 1 0))
  3.     (list
  4.      '(0 . "LINE")
  5.       (cons 10 p)
  6.       (cons 11 (setq q (vlax-curve-getclosestpointto e p t)))
  7.       (cons 62 2)
  8.     )
  9.   )
Logged

mariolino0099

  • Newt
  • Posts: 25
Re: Dynamic Perpendicular
« Reply #10 on: February 17, 2023, 07:32:30 AM »
Many thanks dexus !!! Now it works perfectly !  :smitten:
The last thing is when activating F3 (osnap) comes out of the command... can it be fixed ?
Logged

dexus

  • Bull Frog
  • Posts: 207
Re: Dynamic Perpendicular
« Reply #11 on: February 17, 2023, 08:01:32 AM »
Quote from: mariolino0099 on February 17, 2023, 07:32:30 AM
Many thanks dexus !!! Now it works perfectly !  :smitten:
The last thing is when activating F3 (osnap) comes out of the command... can it be fixed ?
It can be fixed.

Now if you press a key the first part of the value returned by grread is 2.
(the second part will be the key number. Grread info: https://www.theswamp.org/Sources/doc/avlisp/#grread)

So (car g) is 2, but there is only an if statement for 3 which is "selected point".
So what you want to do is check if the output is 2, if so you keep the grread loop going.
Logged

dexus

  • Bull Frog
  • Posts: 207
Re: Dynamic Perpendicular
« Reply #12 on: February 17, 2023, 08:04:50 AM »
Probably easier to understand is you look for some examples in the http://www.lee-mac.com/grsnap.html demo programs.
Demo 2 and Demo 3 handle keyboard input as well.
Logged

mariolino0099

  • Newt
  • Posts: 25
Re: Dynamic Perpendicular
« Reply #13 on: February 17, 2023, 08:24:47 AM »
Unfortunately, my knowledge of lisp is limited and does not allow me to understand what I need to edit .... :-(
Logged
Pages: [1] |   Go Up
« previous next »