Author Topic: Need fresh eye  (Read 3628 times)

0 Members and 1 Guest are viewing this topic.

HasanCAD

  • Swamp Rat
  • Posts: 1420
Need fresh eye
« on: April 09, 2019, 12:19:41 PM »
I am coding a lisp to insert block in midpoint of each segment of Pline
Inserting is OK but while trying to rotate the block the code not accepting the objects
the error in this line
Code - Auto/Visual Lisp: [Select]
  1. (setq obj (nth (setq Mi (1- Mi)) selset))

Error
Quote
Error: bad argument type: consp <Selection set: 5ed>

The code
Code - Auto/Visual Lisp: [Select]
  1. (defun c:CableDirectionArrow ( / AD AN ANG BLK BLKVL BLKVL-RO DOC INC INS MD MI OBJ P1 P2 PL SELSET )
  2.  
  3.  
  4.   (while
  5.     (and (setq obj (car (entsel "\nSelect Polyline: "))) (setq inc 0 ))
  6.     (setq blk "AR")
  7.     (if ;|Create-AR-Block|;
  8.       (not (tblsearch "BLOCK" blk))
  9.       (progn
  10.         (entmake (list '(0 . "BLOCK") '(100 . "AcDbEntity") '(67 . 0) '(8 . "0") '(100 . "AcDbBlockReference") (cons 2 "AR") '(10 0.0 0.0 0.0) '(70 . 0)))
  11.         (entmake '((0 . "LWPOLYLINE") (100 . "AcDbEntity") (67 . 0) (8 . "0") (100 . "AcDbPolyline") (90 . 2) (70 . 0) (38 . 0.0) (39 . 0.0) (10 187.5 -0.000000000000034) (40 . 0.0) (41 . 150.0) (42 . 0.0) (91 . 0) (10 -187.5 0.000000000000034) (40 . 0.0) (41 . 0.0) (42 . 0.0) (91 . 0)))
  12.         (entmake '((0 . "ENDBLK") (100 . "AcDbBlockEnd") (8 . "0")))
  13.         (princ)))
  14.  
  15.     (setq selset (ssadd))
  16.     (while (<= inc (vlax-curve-getEndParam obj))
  17.       (if (and
  18.             (setq p1 (vlax-curve-getPointAtParam obj inc))
  19.             (setq p2 (vlax-curve-getPointAtParam obj (1+ inc)))
  20.             (< 1000 (setq md (distance p1 p2)))
  21.             (setq an (angle p1 p2))
  22.             (setq ang (* 180.0 (/ an pi)))
  23.             (setq ins (polar p1 an (/ md 2 )))
  24.             )
  25.         (progn
  26.           (vl-cmdf "_.-insert" blk ins "1" "1" ang)
  27.           (setq iblk (entlast))
  28.           (ssadd iblk selset)
  29.           )
  30.         )
  31.           (setq inc (1+ inc))
  32.       ) ; While
  33.    
  34.       (initget "Yes No")
  35.       (setq ad (getkword "\nWant to Reverese Arrow Direction [Yes/No]? "))
  36.       (if (= ad "Yes")
  37.         (progn   
  38.          
  39.           (repeat  (setq Mi (sslength selset))
  40.             (setq obj (nth (setq Mi (1- Mi)) selset))
  41.             (setq BlkVL (vlax-ename->vla-object obj))
  42.             (setq BlkVL-RO (vla-get-rotation BlkVL))
  43.             (vla-put-rotation BlkVL (+ (* pi 1) BlkVL-RO)))
  44.           ))
  45.    
  46.   ) ; While
  47.   )
Thanks in advance

ribarm

  • Gator
  • Posts: 3225
  • Marko Ribar, architect
Re: Need fresh eye
« Reply #1 on: April 09, 2019, 01:16:45 PM »
Code - Auto/Visual Lisp: [Select]
  1. (setq obj (ssname selset (setq Mi (1- Mi))))
  2.  

HTH.
Marko Ribar, d.i.a. (graduated engineer of architecture)

:)

M.R. on Youtube

kpblc

  • Bull Frog
  • Posts: 396
Re: Need fresh eye
« Reply #2 on: April 09, 2019, 01:57:15 PM »
Code - Auto/Visual Lisp: [Select]
  1.  
  2. (defun c:cabledirarrow (/ adoc blk_name blk_def ent idx space ins pt answer)
  3.   (if (not (tblsearch "block" (setq blk_name "AR")))
  4.     (progn (setq blk_def (vla-add (vla-get-blocks adoc) (vlax-3d-point '(0. 0. 0.)) blk_name)
  5.                  ent     (vla-addlightweightpolyline blk_def
  6.                                                      (vlax-make-variant
  7.                                                        (vlax-safearray-fill (vlax-make-safearray vlax-vbdouble '(0 . 3)) '(187.5 -3.4e-14 -187.5 3.4e-14))
  8.                                                        ) ;_ end of vlax-make-variant
  9.                                                      ) ;_ end of vla-AddLightWeightPolyline
  10.                  ) ;_ end of setq
  11.            (vla-put-layer ent "0")
  12.            (vla-put-lineweight ent aclnwtbyblock)
  13.            (vla-put-color ent 0)
  14.            (vla-put-linetype ent "byblock")
  15.            (vla-setwidth ent 0 0. 150.)
  16.            ) ;_ end of progn
  17.     ) ;_ end of if
  18.   (while (= (type (setq ent (vl-catch-all-apply (function (lambda () (ssget "_+.:S:E" '((0 . "LWPOLYLINE")))))))
  19.                   ) ;_ end of type
  20.             'pickset
  21.             ) ;_ end of =
  22.     (setq ent   (vlax-ename->vla-object (ssname ent 0))
  23.           idx   0
  24.           space (vla-objectidtoobject adoc (vla-get-ownerid ent))
  25.           ) ;_ end of setq
  26.     (while (and (< idx
  27.                    (+ (if (equal (vla-get-closed ent) :vlax-true)
  28.                         1
  29.                         0
  30.                         ) ;_ end of if
  31.                       (vlax-curve-getendparam ent)
  32.                       ) ;_ end of +
  33.                    ) ;_ end of <
  34.                 (setq pt (vlax-curve-getpointatparam ent (+ 0.5 idx)))
  35.                 ) ;_ end of and
  36.       (setq ins (cons (vla-insertblock space
  37.                                        (vlax-3d-point pt)
  38.                                        blk_name
  39.                                        1.
  40.                                        1.
  41.                                        1.
  42.                                        (angle '(0. 0. 0.) (vlax-curve-getfirstderiv ent (+ 0.5 idx)))
  43.                                        ) ;_ end of vla-insertblock
  44.                       ins
  45.                       ) ;_ end of vla-InsertBlock
  46.             idx (1+ idx)
  47.             ) ;_ end of setq
  48.       ) ;_ end of while
  49.     (if (and (= (type
  50.                   (setq answer (vl-catch-all-apply (function (lambda ()
  51.                                                                (initget "Yes No _ Y N")
  52.                                                                (cond ((getkword "\nReverse arrow direction [Yes/No] <No>? : "))
  53.                                                                      (t "N")
  54.                                                                      ) ;_ end of cond
  55.                                                                ) ;_ end of lambda
  56.                                                              ) ;_ end of function
  57.                                                    ) ;_ end of vl-catch-all-apply
  58.                         ) ;_ end of setq
  59.                   ) ;_ end of type
  60.                 'str
  61.                 ) ;_ end of =
  62.              (= answer "Y")
  63.              ) ;_ end of and
  64.       (foreach item ins (vla-put-rotation item (+ pi (vla-get-rotation item))))
  65.       ) ;_ end of if
  66.     (setq ins nil)
  67.     ) ;_ end of while
  68.   (vla-endundomark adoc)
  69.   (princ)
  70.   ) ;_ end of defun
I thought reverse could be required for evety single polyline.
p.s. sorry, i posted cutted code :)
Sorry for my English.

HasanCAD

  • Swamp Rat
  • Posts: 1420
Re: Need fresh eye
« Reply #3 on: April 10, 2019, 03:18:54 AM »
Code - Auto/Visual Lisp: [Select]
  1. (setq obj (ssname selset (setq Mi (1- Mi))))
  2.  

HTH.
Thanks
Working very well

Sorry for that but what is HTH. mean?

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: Need fresh eye
« Reply #4 on: April 10, 2019, 03:41:39 AM »
A suggestion is set your angle units to radians "aunits 3" then (angle pt1 pt2) is always returned in radians no need to convert to degrees. You can set the angle direction clockwise or anti also.

It may be easier to use the pline co-ords and find mid point rather than using getpointatparam. Then just repeat as you step through co-ords check for closed pline so do 1st and last as an extra at end.
A man who never made a mistake never made anything

HasanCAD

  • Swamp Rat
  • Posts: 1420
Re: Need fresh eye
« Reply #5 on: April 10, 2019, 04:09:55 AM »
Code - Auto/Visual Lisp: [Select]
  1. ...
I thought reverse could be required for evety single polyline.
p.s. sorry, i posted cutted code :)

WOW WOW WOW
Thnaks for coding


Edit: Is there a good example for creating Block using VL-
« Last Edit: April 10, 2019, 07:21:25 AM by HasanCAD »

CAB

  • Global Moderator
  • Seagull
  • Posts: 10401
I've reached the age where the happy hour is a nap. (°¿°)
Windows 10 core i7 4790k 4Ghz 32GB GTX 970
Please support this web site.

Lee Mac

  • Seagull
  • Posts: 12906
  • London, England
Re: Need fresh eye
« Reply #7 on: April 10, 2019, 08:11:50 AM »
Edit: Is there a good example for creating Block using VL-

Vanilla & VL examples

BIGAL

  • Swamp Rat
  • Posts: 1398
  • 40 + years of using Autocad
Re: Need fresh eye
« Reply #8 on: April 10, 2019, 11:34:45 PM »
Another example this has a square or a circle create block choice, with a central attribute.
A man who never made a mistake never made anything