Topic: 3dpoly - distance- perp

[flopo]

Hello everybody,
after drawing perpendicular lines from points to a 3dpoly, I have to measure the distance between consecutive  intersection 3dpoly - perpendicular line.  A lisp to do this will help me a lot... See the attachment - drawing. Thanks!

[fixo]

Try this one
(Layer "perp" must be exist)

Code: [Select]

(defun C:P3P  (/ base en ent perp pt sset)
  (if
    (setq ent (entsel "\nSelect curve >>"))
     (progn
       (setq en (car ent))
       (princ "\n  >>  Select points")
       (setq sset (ssget (list (cons 0 "POINT"))))
       (while (setq pt (ssname sset 0))
(setq base (cdr (assoc 10 (entget pt))))
(setq perp (vlax-curve-getclosestpointto en base))
(entmake (list
    '(0 . "LINE")
    '(100 . "AcDbEntity")
    (cons 67
  (if (= 0 (getvar "tilemode"))
    1
    0))
    (cons 410 (getvar "ctab"))
    '(8 . "perp")
    '(100 . "AcDbLine")
    (cons 10 base)
    (cons 11 perp)
    ))

(ssdel pt sset)
)
       )
     )

  (princ)
  )
(princ "\n\t\t***\tStart command with P3P ...\t***")
(prin1)
(vl-load-com)
~'J'~

[CAB]

To keep up with this thread you shoud view the following:
http://cadtutor.net/forum/showthread.php?t=42442

Here is your fix:
http://cadtutor.net/forum/showpost.php?p=286596&postcount=13

http://cadtutor.net/forum/showthread.php?t=42505

http://www.theswamp.org/index.php?topic=31120.0
http://www.theswamp.org/index.php?topic=31110.0

http://discussion.autodesk.com/forums/thread.jspa?messageID=6296446
http://discussion.autodesk.com/forums/thread.jspa?threadID=753908&tstart=0

[fixo]

Hello everybody,
after drawing perpendicular lines from points to a 3dpoly, I have to measure the distance between consecutive  intersection 3dpoly - perpendicular line.  A lisp to do this will help me a lot... See the attachment - drawing. Thanks!

Oops, forgot about text
Try this instead

Code: [Select]

(defun C:P3P  (/ base en ent perp pt pt_list sset txthgt txtpt)
  (if
    (setq ent (entsel "\nSelect curve >>"))
     (progn
       (setq en (car ent))
       (princ "\n  >>  Select points")
       (setq sset (ssget (list (cons 0 "POINT"))))
       (while (setq pt (ssname sset 0))
(setq base (cdr (assoc 10 (entget pt))))
(setq perp (vlax-curve-getclosestpointto en base))
(setq pt_list (cons perp pt_list))
(entmake (list
    '(0 . "LINE")
    '(100 . "AcDbEntity")
    (cons 67
  (if (= 0 (getvar "tilemode"))
    1
    0))
    (cons 410 (getvar "ctab"))
    '(8 . "perp");<-- layer for lines
    '(100 . "AcDbLine")
    (cons 10 base)
    (cons 11 perp)
    ))

(ssdel pt sset)
)
       (setq pt_list (reverse pt_list))

      (setq  pt_list (vl-sort pt_list (function (lambda (a b)
    (< (vlax-curve-getdistatpoint en a)
       (vlax-curve-getdistatpoint en b))))
)
       )
       (setq txthgt 0.6);<-- text height
       
       (while (cadr pt_list)
   (setq txtpt (vlax-curve-getclosestpointto
en
(mapcar (function (lambda (p q)
     (/ (+ p q) 2))) (car pt_list)(cadr pt_list)))
)
   (entmake
     (list
       '(0 . "TEXT")
       '(100 . "AcDbEntity")
       (cons 67
  (if (= 0 (getvar "tilemode"))
    1
    0))
       (cons 410 (getvar "ctab"))
       '(8 . "points");<-- layer for texts
       '(100 . "AcDbText")
       (cons 10 txtpt)
       (cons 11
     (list (car txtpt) (+ (cadr txtpt) txthgt) 0.0))
       (cons 40 txthgt)
       (cons 1 (rtos (distance (car pt_list)(cadr pt_list)) 2 2))
       '(50 . 0.0)
       '(41 . 1.0)
       '(51 . 0.0)
       '(7 . "Standard");<-- text style
       '(71 . 0)
       '(72 . 0)
       '(73 . 2)))        
       (setq pt_list (cdr pt_list))
       )
       )
    )
  (princ)
  )
(princ "\n\t\tStart command with P3P ...\t\t")
(prin1)
~'J'~

[CAB]

http://www.cadtutor.net/forum/showpost.php?p=286633&postcount=16

[Lee Mac]

Try this one
(Layer "perp" must be exist)

I believe entmake will create any non-existent layers   

[fixo]

Try this one
(Layer "perp" must be exist)

I believe entmake will create any non-existent layers   

Are you sure?
There is no question about entmakeing layer from OP

~'J'~

[Lee Mac]

Try it:

Code: [Select]

(defun c:test nil
  (entmake '((0 . "LINE") (8 . "LeeMac") (10 . (0 0 0)) (11 . (1 0 0))))
  (princ))


[CAB]

fixo
Here is the thing, this is all that is needed to make a line.

Code: [Select]

(entmake (list (cons 0 "LINE")
               (cons 10 (list 0.0 0.0 0.0))
               (cons 11 (list 0.0 1.0 0.0))
))
Every dxf code missing will be added by ACAD using the current settings for that dxf code.

Therefore you do not need dxf 67 41 or 100.
Unless you want to force something that is not current.

[fixo]

Try it:

Code: [Select]

(defun c:test nil
  (entmake '((0 . "LINE") (8 . "LeeMac") (10 . (0 0 0)) (11 . (1 0 0))))
  (princ))


I repeat again:
There is no question about entmakeing layer from OP
Did you mean I don't know about what you have showed me?

~'J'~

[fixo]

fixo
Here is the thing, this is all that is needed to make a line.

Code: [Select]

(entmake (list (cons 0 "LINE")
               (cons 10 (list 0.0 0.0 0.0))
               (cons 11 (list 0.0 1.0 0.0))
))
Every dxf code missing will be added by ACAD using the current settings for that dxf code.

Therefore you do not need dxf 67 41 or 100.
Unless you want to force something that is not current.

Alan, you too
Sorry, I haven't a time

~'J'~

[Lee Mac]

Fixo, in your post you stress that the layer must exist before running the program. I was showing you that the layer needn't exist, as entmake would create it.

[CAB]

fixo,
you code works fine.

[fixo]

Fixo, in your post you stress that the layer must exist before running the program. I was showing you that the layer needn't exist, as entmake would create it.

Sorry, but you realy got me
Where you can see in your code all the layer properties -
color, lineweight etc etc etc - that I mean
Take it easy

~'J'~

[fixo]

fixo,
you code works fine.

Thanks, Alan
I hope

~'J'~

[Lee Mac]

Fixo, in your post you stress that the layer must exist before running the program. I was showing you that the layer needn't exist, as entmake would create it.

Sorry, but you realy got me
Where you can see in your code all the layer properties -
color, lineweight etc etc etc - that I mean
Take it easy

~'J'~

Obviously you would need to change these separately, but what I am getting at is that the code will not error if the layer is not present.