TheSwamp

Code Red => AutoLISP (Vanilla / Visual) => Topic started by: HasanCAD on April 09, 2019, 12:19:41 PM

Title: Need fresh eye
Post by: HasanCAD 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.  (vl-cmdf "_.-insert" blk ins "1" "1" ang)
  26.  (setq iblk (entlast))
  27.  (ssadd iblk selset)
  28.  )
  29. )
  30.  (setq inc (1+ inc))
  31.      ) ; While
  32.  
  33.      (initget "Yes No")
  34.      (setq ad (getkword "\nWant to Reverese Arrow Direction [Yes/No]? "))
  35.      (if (= ad "Yes")
  36. (progn  
  37.  
  38.  (repeat  (setq Mi (sslength selset))
  39.    (setq obj (nth (setq Mi (1- Mi)) selset))
  40.    (setq BlkVL (vlax-ename->vla-object obj))
  41.    (setq BlkVL-RO (vla-get-rotation BlkVL))
  42.    (vla-put-rotation BlkVL (+ (* pi 1) BlkVL-RO)))
  43.  ))
  44.  
  45.  ) ; While
  46.  )
Thanks in advance
Title: Re: Need fresh eye
Post by: ribarm on April 09, 2019, 01:16:45 PM
Code - Auto/Visual Lisp: [Select]
  1. (setq obj (ssname selset (setq Mi (1- Mi))))
  2.  

HTH.
Title: Re: Need fresh eye
Post by: kpblc 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 :)
Title: Re: Need fresh eye
Post by: HasanCAD 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?
Title: Re: Need fresh eye
Post by: BIGAL 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.
Title: Re: Need fresh eye
Post by: HasanCAD 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-
Title: Re: Need fresh eye
Post by: CAB on April 10, 2019, 08:09:28 AM
http://www.theswamp.org/index.php?topic=29637.msg404310#msg404310
Title: Re: Need fresh eye
Post by: Lee Mac on April 10, 2019, 08:11:50 AM
Edit: Is there a good example for creating Block using VL-

Vanilla & VL examples (http://www.theswamp.org/index.php?topic=45643.msg508165#msg508165)
Title: Re: Need fresh eye
Post by: BIGAL on April 10, 2019, 11:34:45 PM
Another example this has a square or a circle create block choice, with a central attribute.